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Compound  Leg  Basic  Solution 

CSLACK  -  EOGPT  ,  PAGES  <?0-/64 


et  svs  f inal/t2for/cslack  forM 
subroutine  CSLACK 

************************************************************************ 
implicit  integer*2  (**) 

mieger*2  ileg.ist  ,nca  >ncb  .nwa  >n«b  >isol  .ibrnch  ,uz  15  ) 
double  precision  z  (67  )  ,cz  ,cx  >d  ,ta  ,tb 

common  /VGLOB/  i  leg  ,  1  s t  ,nca  ,ncb  .z  ,cz  ,cx  ,d  .  ta  , rb  ,n»a  ,nwb  , 

4  isol  .Ibrnch  ,uz 
double  precision  za( 25)  >zb(25) 
equivalence  (z ( 1  )  ,za( I  1  1  , (z (26  1  ,zb ( 1  ) ) 

double  precision  ha  .a  1  a  ,va  isl a  .*1  a  >ct a  ,s2a  ,«2a  ,c2a  ,s3a  ,w3a  , 

4  xa  .va  ,x?a  ,x2a  ,x3a  ,y la  ,y2a  .y3o  , 

4  t  ano2a  ,  t  ana3a  ,  t  anal a > t anoSa  ,  t ana6a  > I  a  ,ph i a 
equ i va 1 ence  ( za ( 1  I >ha I  i(za(2)  ,a I  a  .  va I » 

4  (za(3)  ,slal  ,  lza(1  I  ,t»1a)  i(za(5l  ,clal  , 

4  <za(6l  ,s2a)  ,(za(7)  ,*2a  I  ,(za(8)  ic2al  . 

4  (za!9 )  ,s3a )  ,  lza( 10 )  ,*3a  I  , lza( 1 1  )  >xa  )  ,  I za ( 1 2  )  .ya )  » 

4  (za  ( I  3  )  ,xl  a  )  ,(za(MI  ,x2a  1  ■  (za(  I  5  I  ,x3a  )  , 

4  ( za  ( 1 6  )  ,y  I  a  )  ,  ( za  ( 1  7  1  ,y2a  I  ,  ( za  ( 1 8  )  .y  3a  )  , 

4  (za(  1 9  I  ,t ana2a  I  , (ze(20  I  ,t ana3a  I  ■  l za (21  I  , tanala  I  , 

4  ( za ( 22  )  >  t  ana5a I  ,  l za ( 23  I  .  t  ana6a I  .  t  za ( 21 )  .la)  .  I za ( 25 ) .ph ■ a  I 

double  precision  hb  ,alb  .vb  ,s!b  .wlb  .clb  >s2b  >w2b  >c2b  ,s3b  >w3b  . 

4  xb  .yb  ,xlb  ,x2b  ,x3b  .ylb  .y2b  ,v3b  . 

4  t  ana2b  ,  t  ana3b  ,  t  analb  .  t  ana5b  .  t  ono6b  ,  I b  ,ph i b 
equ i va 1 ence  ( zb ( I  I  .hb  )  .  ( zb ( 2 )  .a I b  .  vb  I  . 

4  t zb ( 3  I  .slb)  , ( zb ( 1 1  ,w1b)  .(zb (51  .clb)  > 

4  (zb  (6  I  ,s2b  I  ,  ( zb  ( 7  )  ,«2b)  ,(zb(8)  ,c2b  I  , 

4  (zb (9  I  ,s3b  )  ,  (zb ( 1 0  I  ,«3b  I  ,(zb< II )  ,xb )  ,  I zbl 1 2 1  .yb I  , 

4  (zbl  1 3 1  .xlb I  , (zb(  1 1 1  ,x2b I  , ( zb ( 1 5 1  ,x3b)  , 

4  ( zb  ( 1 6 1  ,ylb)  ,(zb(l7l  ,y2b)  ,lzbll8)  ,y3b)  , 

4  (zb (19 1  .tana2bl  .(zb (20)  .tana3b>  >(zb(2l  I  , t analb)  > 

4  (zb (22 1  > t  anaSb  I  ,  ( zb (23  I  ,tana6b)  ,(zb(21 1  ,1b  I  ,  I  zb (25 1  .phib) 
double  precision  coi  1  .sip  ,frct  ,c3  ,s1  ,*1  .xl  ,y1  ,»ano7  , tana8  ,1  , 

4  h.phih.rtot  .xtot  ,ztot  ,do 

equi valence  (z (51  I  .coi 1  I  ,(z (52  I  ,s Ip  I  » (z 153  I  ,frc  t  I  ,  (z (51 1  ,c3  I  , 

4  ( z  ( 55  I  .sll  ,  (z  (56  )  .till  ,  l  z  (57  I  ,x1 1  ,(z(58)  .yl  I  . 

4  (z (59  I  ,  tana 7  I  ,  (z (60  I  ,  tona8 I  , ( z (61  I  ,1  I  , 

4  (z(62)  ,h)  ,(z(63l  .phihl  , 

4  (z (61 1  ,r tot  I  >(z (65 1  ,x tot  )  , (z (66  I  .z  tot  I  , (z (67 )  ,do I 
integer *2  iuks 
equivalence  (uz(3).iuks) 


double  precision  pi  .halfpi  , degrad  ,roddeg  , zero >one >hal f 
integer*2  tzero  iione >1  two 

common  /VCONST/  pi  ,hol fpi  , degrad  ,raddeg  .zero  ,one ,hal f , 

4  i zero  ,  i one  .  1 1  wo 

i n  t  eger *2  i scopa  ,  i scopb  >  1 1  ana  ,  1 1  anb  tit  > i s 
double  precision  epsy  , gamma  ,se 

common  /VCMPD/  epsy  .gamma  .36  ,  i scopa  ,  i scopb  ,  i i ana  , 1 1 onb , 1 1  , i s 
integer*?  i told 

double  precision  ss0  >dten0  ,ss I  .dtenl  ,ss2  ,dten2  ,slp0  ,sa0  ,smin(2  ) 
common  /VEQUAL/  ss0  >dten0  .ssl  .dtenl  ,ss2  ,dten2  ,slp0  ,sa0  .srnin  , 

&  Hold 

equ i va 1 ence  ( sm i n 1 1 1  ,sam i n 1  ,  ( sm i n ( 2 1 >sbm i n ) 

double  precision  sa  ,sb  ,ca  .cb  ,vc0a(6 1  ,vc0b(6 )  . 

4  eex0  ,eez0  ,eey0  ,a0  >b0  ,phia0  .phib0 
integer *2  icase 

common  /VSPIO/  sa  .sb  .ca  ,cb  ,vc0a  ,vc0b  . 

4  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0  , 

4  icase 

double  precision  snph ih  .cspbih  .snafh  .esafh  , t nafh  .scofh  .dsnph 
common  /VHOIR/  snph i h  , cspbih  .snafh  .esafh  ,t nafh  .scafh  .dsnph 

double  precision  htnafh  ,hwA  ,wAh  .sAwAh  ,c3h 
common  /VHVEC/  htnafh  ,hwA  ,wAh  .sAwAh  ,c3h 

double  precision  epsxz  ,xz tru (2 1  .xzbas (2  )  >hbas 12 )  .scrat 1 1 1 0 ) 
common  /VCSSXZ/epsxz  .xztru  .xzbos  ,hbas  .scrot I 
double  precision  xtru  .ztru  ,xbos  ,zbas  .hbasx  .hbasz 
equivalence  (xztrud  )  .xtru)  .(xztru(2)  .ztru)  . 

A  1 xzbas ( 1  1  ,xbas I  .  ( xzbas 1 2 )  ,zbas )  . 

&  (hbasll  )  .hbasx )  ,(hbas(2)  .hbasz) 

integer *2  it ant 

double  precision  a.b.snphi  .tnafa  .tnafb  . 

4  seca7  .secaS  >ut  ,st  ,y h  t  ,z h  «  ,eex  ,eez  ,eey  .ybuoy 
common  /VCSSHP/  a.b.snphi  .tnafa  .tnafb  . 

4  seca7  >seca8  ,ut  ,st  ,yk  t  ,zk  t  ,eex  ,eez  ,eey  .ybuoy  ,i  tent 


integer *2  ivs 

double  precision  v0,vl  ,v2,f0,fl  ,f2  .f  >eps 


common  /VSEC/  v0,v1  ,v2,f0,fl  >f2  ,f  ,eps,ivs 
double  precision  y array (3 ),  far ray  131 
equivalence  (v0,varray)  ,  (f0,forroyl 

mteger*2  i  lh0  ,i  lhl  >1  lh2  ,i  1 

double  precision  lh0  ,lht  ,lh2,ce 

common  /VSCOIL/  lh0,lhl  ,lh2  ,ce  ,1  lh0  .i  lhl  , ilh2.il 

inieg er*2  ilh(3) 

double  precision  lh(3) 

equivalence  ( i Ih  ,i lh0)  ,1 lh  ,lh0) 

double  precision  xred 
inieger*2  isidf  ,nerra  ,nerrb 
common  /VSTAB/  xred  iisidf  ,nerra  ,nerrb 
***************************** ********************** tt**s****t*t**t*t**t* 
*  BECIN  EXECUTABLE  COOE 

************************************************************************ 
call  ovl ink ( 'CPREP0  ‘  ) 
if  ( i leg  eq  31  call  CPREPI 
goto  ( 1 000  1 2000  1 3000 1  i  luks 

1000  continue 

call  CPREP2 
call  CPREP3 

if  ( 1 1  eg  ne  3 1  goto  1 200 
call  ovlink ( 'CS5HP  'l 
goto  1500 
1200  continue 

cal  1  ovl ink ( ‘CSEHP  '  ,01 
1 500  con  1 1 nue 
goto  5000 

2000  con  1 1 nue 

call  CPREP2 

if  (l leg  ne  3)  goto  2200 
cal  1  ovl  ink  (  XSSPR  '  ,01 
goto  2500 
2200  continue 

coll  ov 1  ink ( 'CSEPR  ',01 
2500  com i nue 
goto  5000 


3000  continue 


el  sys  f  mol/  (2for/cprep0  forH 
subroutine  CPREP0 

************************************************************************ 
implicit  integer*?  («l 
implicit  double  precision  (a-zl 


implicit  double  precision  (a-z) 

i n teger *2  i  leg  > i s  t  ,nca  ,ncb  ,n«ra  ,n»b  ,  i  sol  ,  ibrnch  ,uz  15  ) 
double  precision  z  (67  1  ,cz  ,cx  ,d  ,  ta  ,tb 

common  /VCLOB/  i  leg  >ist  .nca  ,ncb  ,z  ,cz  ,cx  ,d  ,ta  .tb  ,nwa  ,nwb  , 

4  i sol  .ibrnch  ,uz 
double  precision  za(25  I  , zb  125  I 
equ  i  va  I  ence  ( z  1 1  )  ,za  ( I  II  i  ( z  1 26  I  ,zb  ( I  I  ) 

double  precision  ha  ,a  I  a  ,va  iSl  a  ,w  I  a  ,cl  a  .s2a  >»2a  ,c2o  ,s3a  ,w3a  , 

4  xa  ,ya  .xla  .x2a  .x3a  ,y  la  ,*2a  ,y3a  , 

4  t  ana2a  ,  t  ana3a  ,  t  anala  ,  t  ana5a . t  ana6a , 1  a  ,ph i a 
equivalence  (za( 1  I  ,ha I  >(za(2l  .ala  ,va  I  , 

4  (za(3l  .slal  ,(za(4)  ,«rta)  .(zalSI  ,clal  , 

4  (za(6l  ,s2a)  ,tza(7!  ,w2a I  ,(za(8l ,c2a)  . 

4  (za(9l  ,s3al  ,(za( 10)  ,w3a )  ,  (za( 1  I  I  ,xa>  ,  lza( 12  i  ,y a)  . 

4  I zo (13)  ,x la  i  , ( zai  M  )  ,x2a  I  , ( za 1 15  )  ,x3a  )  > 

4  (za(  161  ,y  la  I  ,(zall  7  I  ,v2a  I  ,(za(  181  .y3a>  , 

4  < za (19  1  iiana2a)  ,  (za(20>  .tona3al  ,  (zal21  >  ,  tana4a>  , 

4  I za (22  l  ,  tanaSa  I  ,  (za(23  I  ,  tana6a )  , (zo  f 24  )  ,  I o 1  , 1 za 125  >  ,phia) 

double  precision  hb  ,alb  ,vb  .sib  ,»lb  ,clb  >s2b  ,«*2b  ,c2b  ,s3b  ,»3b  , 

4  xb  ,yb  ,xlb  .x2b  ,x3b  ,y!b  ,y2b  ,y3b  . 

4  t  ana2b  ,  t  ana3b  .  t  ana4b  ,  t  ana5b  ,  t  ana6b  ,  1 b  .ph i b 

equ  i  va  1  ence  ( zb  t  I  I  ,hb  I  .  ( zb  ( 2  I  .a  1  b  .  vb  I  , 

4  I  zb !  3  l  >s  I  b  I  .  ( zb  ( 3  I  .in  1  b  I  .  ( zb  1 5  I  >c  I  b  I  , 

4  (zb  16  l  ,s2b  I  .  ( zb  (  7  l  ,«2b  I  ,  (  zb  ( 8  I  ,c2b  )  , 

4  (zb (9  I  ,s3b  I  ,  (zb(  10  )  ,»3b  l  ,  (zbl  I  1  I  ,xb  i  ,  (zb  I  12  I  ,yb>  . 

4  ( zb  ( I  3  l  ,x  I  b  I  ,  ( zb  (  M  I  ,x2b  I  .  ( zb  1 1 5  J  ,x3bl  . 

4  (zbl  16  l  ,y  lb  I  ,  (zb  ( I  7  I  ,y2b  I  ,  ( zb  1 1 8  )  ,y3b  I  , 

4  I  zb (19)  ,tana2b>  ,(zb(20l  >tana3bl  > ( zb ( 2 1  I  .tana^bl  . 

4  ( zb ( 22  I  .  t  anaSb I  .  ( zb ( 23  I  .  t ana6b I  .  • zb ( 2*  I  .  1 b  I  .  ( zb ( 25 )  .ph i b ) 
double  precision  coi  1  .sip  .fret  .c3  ,s4  ,w4  ,x4  ,y4  ,tana7  , tana8  .1  . 

4  h.phih.rtot  ,xtot  .ztot  .do 

equivalence  (z (51  I ,coi 1  I  . (z 152  I  ,s lp  I  ,  ( z 153  I  ,  fre  t  I  ,  ( z (54  I  ,c3  I  . 
4  (z(55  I  ,s4  I  ,(z  (561  I  ,lz(57  I  ,x4  I  ,(z  (58  I  ,vi  I  . 

4  Iz (59  I  .  tana 7  )  ,  (z (60  I  .  tana8 I  ,  (z (61  I  ,1 )  , 

4  ( z  ( 62  I  ,h  I  ,  ( z  (63  I  ,ph  i  h  I  , 

4  (z  (64  I  ,r  tot  I  .  ( z  (65  I  .x tot  I  ,  ( z  (66  I  .ztot  I  ,  ( z  (67  I  ,do  I 
in teger *2  nc(2> 
equivalence  (nca.ncl 


integer *2  uzl  ,uz2 

equivalence  luz  1 1  )  >uzl )  , luz 12 1  ,uz2 ) 


9^ 


double  precision  pi  ,halfpi  .degrad  .raddeg  iZero  ,one  ,hal f 
integer *2  i zero  . ione  , i two 

common  /VCONST/  pi  ,hal fpi  , degrad  .raddeg  ,zero  ,one  ,hal f  . 

&  i zero  ,i one  ,i  i wo 

double  precision  delyk  .iwod  ,hal fd  ,dsq 
common  /VANCH/  de 1 y k  ,  t »od  ,ho 1 f d  ,dsq 

i nt eqer *2  i scopa  ,  i scopb  ,  i t ana  ,  i t  anb  ,  i I  ,  i s 
double  precision  epsv  .gamma  ,se 

common  /VCMPD/  epsv  ,gammo  ,se  ,i scopa  ,i scopb  , i tana  , i tanb  ,i t  ,is 
integer *2  Hold 

double  precision  ss0  ,dten0  ,ssl  .dtenl  ,ss2  >dt en2  .s I p0  ,sa0  ,smi n ( 2  ! 
common  /VEQUAL/  ss0  ,dten0  ,ssl  , dtenl  ,ss2  .dten2  .s lp0  ,so0  ,sm m  , 

A  i told 

equ  i  va  1  ence  Isminl  I  !  ,sam  ml  ,  (  sm  i  n  ( 2  I  ,sbm  i  n  ) 
mteger*2  i  1  ,i  ,j  ,n 

***** ******************************************************************* 
i tana-2*nca+ I  7 
i i anb-2*ncb+ I  7 
i scope- 3*nca 
i scopb-3*ncb+2S 
se-z ( i scopa  I  +z  (  i scopb  1 

vk-cz*hel fd 
do  20  1 1  - 1  ,2 
smn- (do-yk  l-sl 
n-nc 111) 
do  10  i  - 1  ,n 
if  I i  eq  11  goto  10 
j-25*  I  i  I  -1  1  +  1*1 i-l  ) 
smn-smn-z ( j 1 
10  com  mue 

smml  1 1  l-dmaxl  (smn  ,zero  1 
yk-  -yk 
20  coni inue 


7° 


s lp0-dmex  1  (dm  in  I  1  s  lp  >z  I  i  scopa  I  -samm  1  ,sbmin-z  I  i  scopb  I  1 


ei  sys  f mal / f ^for/cprepl  for M 
subroutine  CPREP1 

*tntmm****»***m*«mm*»»»********M«f**»»*<**««»mitm»m 

implicit  double  precision  <a-2) 

integer*2  i  leg  .ist  ,nca  incb  ,n«a  ,nwb  ,isol  .ibrnch  ,uz  15  I 
double  precision  z  <67  I  ,cz  ,cx  ,d  ,  t  a  ,  tb 

common  /VGL08/  1  leg  ,ist  ,nca  ,ncb  ,z  icz  ,c«  ,d  ,ta  ,tb  ,nwa  >n«rb  , 

A  1  sol  .ibrnch  ,uz 
double  precision  za  (2S  I  ,zb  (25  I 
equi valence  (2(1)  ,2a  I)  )  )  ,  ( 2 (26  I  ,2b ( II) 

double  precision  ha  ,a1a  ,va  ,sla  ,wla  ,cla  ,s2a  >*2a  ,c2a  ,s3a  ,»3a  , 

A  xa  ,ya  ,xta  ,x2a  ,x3a  ,y1a  ,y2a  ,y3a  , 

A  t  ana2a  ,  t  ana3a  ,  f  ana4a  ,  t  anaSa  ,  t  ana6a  ,  I  a  ,ph  i  a 
equ  1  val  ence  ( 20  ( 1  1  ,ha  I  ,  1 20  ( 2  )  ,ala,vai  , 

A  (zal3l  ,sla)  ,(2aMI  ,wlal  ,(za(5l  ,cla)  , 

A  (za  16  l  ,s2a  I  ,(2a(7l  ,w2a  I  ,(za(8)  ,c2al  , 

A  ( za  (9 )  ,s3a  )  ,  ( za  ( 1 0  )  ,»3a  )  ,  I  za  I  H  I  ,xal  ,  I  za  (I  2  )  ,ya)  , 

A  ( za(  1  3  1  ,xl  a  I  ,  1  za(  M  I  ,x2a  I  ,  (  za  ( 1 5  I  ,x3a  )  , 

A  l za (161  ,yla)  ,(za(17l  ,y2al  ,120(18)  ,y3al  , 

A  (za  (  1 9  1  ,  tana2a  1  ,  ( za ( 20  I  ,  tana3a  )  ,  (2a 1 21  )  ,1  ana'la  )  , 

A  ( za(22  I  ,tana5o  I  ,  ( za  (23  I  ,1  ana6a  1  ,  ( zo  ( 24  )  ,1a)  ,  I  za  1 25  )  ,ph  1  a  ) 

double  precision  hb  ,alb  ,vb  ,slb  ,xv  1  b  ,c!b  ,s2b  ,*2b  ,c2b  ,s3b  ,w3b  , 

A  xb  ,yb  ,xtb  ,x2b  ,x3b  ,ylb  ,y2b  ,y3b  , 

A  1 ana2b  .  1 ana3b  ,  t  onalb  ,  t  ana5b  ,  1 ana6b  ,  I b  ,ph 1 b 
equ  1  valence  ( zb  (  1  I  ,hb  )  ■  I  zb  12)  ,a  I  b  ,vb  )  , 

A  ( zb  ( 3  1  ,s!b)  ,  ( zb ( 4  I  ,»lbl  ,(zb(51  ,c  I b  1  , 

A  (zb (6)  ,s2b  )  ,(zb(7)  ,w2b  I  ,(zb(8)  ,c2b  )  , 

A  (zb  (9  I  ,s3b  )  ,(zbl  101  ,»3b  )  ,(zb(l  I  )  ,xb  )  ,  (zbll2  )  ,yb  )  , 

A  lzb(  1  3  1  ,x  lb  I  ,  ( zb 1 1  4  )  ,x2b  I  ,  (  zb  ( 1 5  1  ,x3b  )  , 

A  (zb (16)  ,vlbl  ,(zb(171  ,y2b  I  ,(zbM8l  ,y3b)  , 

A  ( zb ( 1 9  )  ,  1 ana2b  )  ,  I  zb ( 20  I  ,  t ano3b !  ,  ( zb  1 2 1  )  ,1 ana4b  )  , 

A  (zb (22  I  ,  t  ana5b I  ,  ( zb ( 23  1  ,  t ano6b  1  ,  ( zb  1 24  )  ,lbi  ,  ( zb  1 25 )  ,ph ib  ) 

double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,»4  ,x4  ,y 4  ,rana7  ,tana8 ,1  , 

A  h  ,phih  ,rrot  ,xtot  ,zto)  ,do 

equivalence  lzl5)  )  ,coil  )  ,  ( z (52  )  ,slp)  ,(z!53)  ,frct  )  ,(z(54)  ,c3l  , 

A  (z(5S)  ,s4  )  ,  ( z  ( 56  )  ,w4  I  ,  (  z  ( 57  I  ,x4  )  ,tz  158  )  ,y4  J  , 

A  (z(59t  ,  t  ana 7  I  ,(z(60)  , tanaB)  ,(z(6l  1,1), 

A  I  z  1 62  )  ,hl  , (z(63l  ,ph  1  h  )  , 

A  ( z  ( 64  )  ,rtot  I  ,  ( z  (65  )  ,xtot  )  ,(z(66)  ,ztot  )  ,(z(67)  ,do) 

double  precision  pi  ,hal fpi  , degrad  ,raddeg  , zero  , one  ,hal f 
integer*2  izero  ,ione  ,1 1*0 


98 


common  /VCONST/  pi  ,hal fpi  , degrad  ,raddeg  izero  ,one  ,hai f  , 

A  izero  ,ione  ,i  two 

doub 1 e  precision  de 1 v k  1 1 wod  .ha  1 f d  .dsq 
common  /VANCH/  de I y k  . t wod  ,ha 1 f d  idsq 

double  precision  sa  .sb  ,ca  iCb  ,vc0a  (6  i  ,vc0b  16  )  , 

A  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0 
mteger*2  icase 

common  /VSPID/  sa  .sb  ica  .cb  ,vc0a  ,vc0b  , 

&  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0  , 

&  icase 

equi valence  (czsql  >eez0  I  .  (ddsq  .eta  .eex0  )  ,  laasq  ,eey0  )  . 

4  ( aambb  ,eex0sq  ,b0sq  ,ph  i  b0  )  ,1  a0sq  .ph  i  a0  ) 
************************************************************************ 
call  SUMSC  (nca  ,za  .sa  .ca  1 
call  SUMSC  (neb  ,zb  ,sb  ,cb  I 
call  VCR  I T0 (nca  ,za  ,vc0a  1 
call  VCRI T0(ncb  ,zb  ,vc0b  1 
czsql -cz*cz+one 
ddsq-dsq*czsq1 
i case- 1 

if  ((sa-sbl**2  gt  ddsq  1  goto  100 
i case-2 
aasq-sa*sa 
aambb -oasq~sb*sb 

eta-dsqr  t ( (A  0d0*aasq*ddsq- (ddsq* aambb  )**2)/lcx*cx+czsql  )) 

eez0-  - ( aambb *cz*cx*e  t  a  1 / ( t  wod*czsql  1 

eex0-e  t  a/ 1  wod 

eey0-cx*eex0+cz*eez0 

eex0sq-eex0*eex0 

a0sq-eex0sq* (eez0-hal fd  1**2 

b0sq-eex0sq* (eez0*hal fd)**2 

o0-dsqr  t (a0sq  1 

b0-dsqr  t (b0sq I 

call  PHI  AB(a0  .b0  ,a0sq-b0sq  ,dsq  ,  twod  ,phia0  ,phib0  ) 

1 00  con  t i nue 
■~e  t  urn 
end 


-O 

do 


<?<» 


el  sys  f inal/t2for/sumsc  forM 

subrout  me  SUMSCInc  ,z  ,s  ,c  I 

******************** ********************************************** ****** 

implicit  double  precision  la-zl 

integer *2  nc 

double  precision  z(2S)iS>c 

******************** **************************************************** 

s-z(3  1 
c-s*zM  ) 

if  (nc  eq  1  I  goto  100 
s-s*z(6) 

c-c  +  z (5  l  +  z(6  l*z ( 7  I 
if  (nc  eq  21  goto  100 
s-s+z(9) 

c-c+z (8  )  +  z (9l*z(10) 

1 00  con t i nue 
ret  urn 
end 

* 


-O 

-O 


JOO 


ei  sys  final/t2for/cprep2  fortt 
subrout  me  CPREP2 

************************************* *************** ******************** 

implicit  double  precision  (a-z I 

i n  teqer*2  i  leg  , i  s  t  tnco  .neb  .n*a  ,n»b  , i  sol  .  ibrnch  ,uz  (5  ) 
double  precision  z (67  I  ,cz  ,cx  ,d  .  to  , ib 

common  /VGLOB/  i  leg  , is l  ,nco  ,ncb  ,z  ,cz  ,c«  .d  ,to  .tb  ,n«e  ,n»b  , 

4  i sol  .ibrnch  ,uz 
double  precision  zo(25  I  ,zb(2S  I 
equivalence  I z (I  )  ,za ( I  I  I  ,  ( z (26  I  ,zb I  1  )  ) 

double  precision  ha  ,a(  a  ,va  >s  I  a  ,e  1  a  ,c  I  a  >s2a  ,*2a  ,c2a  >s3a  ,«3a  > 

4  xa  ,va  .xla  .x2a  ,x3a  .yla  ,y2a  ,y3a  , 

4  t  ana2a  .  t  ana3a  ,  t  ana3a  .  t  anaSa  ,  t  ana6a  ,  1  a  ,ph i a 
equi  valence  (za(  1  I  .ha  )  .  (za(2  I  .al  a  ,va  1  , 

4  <za(3l  ,sla)  ,(zaM)  ,»1al  ,lza(Sl  ,cla)  . 

4  (za(6l  .s2a)  ,(za(7)  ,w2a  I  ,(za(8)  ,c2a )  . 

4  (za(9 )  ,s3a ) . (zo ( 10 )  .»3a I . (zal II)  ,xa )  ,  Iza 1 12  )  ,ya)  , 

4  ( za  ( I  3  )  >x  1  a  I  ,  ( za  (  M  1  .x2a  1  ,  ( za  ( 1 5  )  ,x  3a  )  , 

4  ( za(  1 6  I  ,y  1  a  I  , ( za(  1  7  I  ,y2a  I  . ( za<  1  8  I  ,y 3a  )  , 

4  (za( 19  I  ,  tana2a  I  ,  ( za (20  I  ,  tana3a  I  ,  ( Za (2 1  )  ,  tana3a  1  , 

4  ( za ( 22  l  .  t  onaSa I  .  ( za ( 23  1  ,  t ana6a  1  .  ( za ( 24  )  ,la)  , 1 za ( 25  )  ,ph i a ) 

double  precision  hb  .alb  ,vb  .sib  .wlb  .clb  .s2b  .*2b  ,c2b  ,s3b  ,w3b  . 

4  xb  .yb  .xlb  .x2b  ,x3b  ,ytb  ,y2b  ,y3b  . 

4  t  ana2b  .  t ana3b  ,  t ona3b  ,  t  anaSb  ,  t ana6b  ,  1 b  ,ph i b 
equivalence  (zbl I  )  ,hb  I  .  I  zb  12  I  .alb  >vb  I  , 

4  ( zb  ( 3  I  .sib)  .izbMl  ,«•  1  b  I  ,  ( zb  <  5  )  ,c  1  b  I  , 

4  (zb(6)  .s2b)  .(zb(7)  ,«2b  1  .(zb(81  ,c2b  )  , 

4  (zb (9)  ,s3b )  ,(zb(  10)  ,*3b  )  ,(zb(  1  1  )  ,xb)  ,(2b(  12  )  ,vb)  , 

4  I  zbl  1  3  I  ,xlb)  ,(zb(  Ml  ,x2b  )  ,tzb(  15  )  ,x3b  )  , 

4  (zbl  16)  ,y1b>  , (zbl  17)  ,y2b  I  ,(zb(18)  ,y3bl  , 

4  (zb ( 19  )  ,tana2b  I  . (zb (20 )  . f ana3b )  , (zb (21 )  ,  tana3b )  , 

4  (zb (22  I  .  t anaSb 1  > ( zb (23  I  ,tana6b  I  .  I zbl 23  )  ,1b)  ,  ( zb  125  )  ,phib ) 

double  precision  coi  I  .sip  ,frct  .c3  ,s3  ,w3  ,x3  ,y3  ,tana7  ,tana8  ,1  . 

4  h.phih.rtot  .xtol  ,ztot  ,do 

equivalence  ( z (51  )  ,co i 1  )  ,(z(52l  .sip)  ,(z(53)  ,frct  )  , ( z (S3  1  ,c3)  . 

4  ( z  (55  I  ,s3  I  ,  ( z  (56  )  ,w3  1  ,  (  z  (57  )  ,x3  )  ,  ( z  (58  1  ,y3  )  . 

4  (z (59  I  ,  tana 7 >  ,  (z (60  )  ,  tanaS  )  .  ( z 161  1  ,1 )  , 

4  (z  (62  )  ,h  I  ,(z  163  )  .phih  )  , 

4  (z  (63  )  ,r  tot  )  .  <z  (65  )  ,x  tot  I  ,  (z  (66  I  ,z  tot  I  ,(z  (67  )  ,do  ) 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  , ha  1 f 
i n  t  eger  *2  i zero  ,  i one  ,  1 1  wo 


001 


common  /VCONST/  pi  ,hal  fpi  , degrad  ,raddeg  .zero  ,or>e  ,hal  f  , 

&  i  zero  >  i  one  ,  i  I  «ro 

double  precision  tnaf.phif 
common  /VOFLR/  tnaf  ,phi ( 

double  precision  snphih  ,csphih  ,snafh  ,csafh  ,inafh  ,scafh  idsnph 
common  /VHDIR/  snphih  .csphih  ,snafh »csafh  ,tnafh  >scafh  .dsnph 
************************************************************************ 
csphih-dcos Iphih I 
snph i h-ds i n ( ph i h  ! 
inafh-dcos(phih-phi f l*tnaf 
scafh-SECNT ( inafh ) 
snafh- tnafh/scafh 
csafh-one/scafh 
dsnph-d*snph i h 


I 


to? 


ei  sys  f inal/t2for/cprep3  forM 
subroutine  CPREP3 

txxtxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

implicit  double  precision  (a-zl 

mteger»2  ileg.ist  ,nca  >ncb  .nwa  ,n«ib  , i sol  .ibrnch  ,uz(5  I 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,ta  ,tb 

common  /VCLOB/  i  leg  , i s t  ,nca  >ncb  >z  ,cz  ,cx  ,d  , t a  , tb  .nwa  ,n»b  , 

A  isol  .ibrnch  ,uz 
double  precision  za (25  I  .zb (25 1 
equivalence  ( z ( 1  I  ,za (1  H  , ( z (26 1  iZb ill) 

double  precision  he  ,ala  ,va  ,sla  ,*ta  ,cla  >s2a  ,w2a  >c2o  »s3a  ,«3a  > 

A  xa  ,ye  ,x  I  a  ,x2a  ,x3a  ,y  I  a  ,y2a  ,y3a  . 

A  t  ana2a  1 1  ana3a  ,  t  ana4a  .  t  anaSa  1 1 ana6a  ,  I  a  ,ph i a 
equivalence  (za( 1  I  .ha  1  ■  <za<2 1  ,a!a  ,va  )  , 

A  I za( 31  ,slal  ,lzaM  1  ,»lal  , (za  15)  .cla)  » 

A  (za(6  I  ,s2a  1  .(za  (71  ,»2a  I  ,(za(8)  ,c2al  , 

A  ( za(9  )  ,s3a  )  ,  ( za<  10  I  ,w3a  1  ,  (za(  II  1  ,xa  I  >  (za  112)  .va  )  , 

A  (za(  1  3  I  ,x  I  a  I  ,  (za(  14  I  ,x2a  )  .  ( zat  1 5  I  ,x3a  )  , 

A  (za(  16  l  ,y  la  I  ,(za(  1  7  )  ,y2a  I  , I za(  18  I  ,y3a  I  , 

A  ( za ( 1 9  1  ,  t ana2o  )  ,  I za ( 20  )  ,  t ana3a  I  ,  ( zo 1 2 1  )  ,  t  ona«a  )  , 

A  I za ( 22  )  1 1  anaSa  I  .  ( za ( 23  )  .  t  ana6a )  ,  ( zo 1 24  )  »la)  ,(zal25)  ,ph i a ) 
double  precision  hb  .al b  ,vb  .s  1  b  .» I b  >c  I  b  .s2b  ,w2b  ,c2b  ,s3b  >»3b  > 

A  xb  ,yb  ,xlb  ,x2b  ,x3b  .ylb  .y2b  .v3b  . 

A  t  ana2b  .  t  ana3b  ,  t  ana4b  ■  t  ana5b  ,  t ana6b , I b  »ph i b 
equ  i  va  1  ence  l  zb  ( I  )  ,hb  )  ,  ( zb  ( 2  )  ,a  I  b  ,vb  )  . 

A  ( zb  ( 3  I  iS  I  b  )  ,  ( zb  1 4  )  ,« I  b  )  ,  I  zb  ( 5  I  ,c  1  b  I  , 

A  I  zb  (6  I  ,s2b)  >  l  zb  C  7  )  ,»2b  I  ,(zb(8l  ,c2b)  , 

A  l zb (9)  ,s3b  )  .Izbl  10)  ,»3b )  ,  (zb  ( I  I  j  ,xb  J  ,  (zb  1 1 2  )  ,yb  )  , 

A  (zb 1 13  )  ,xlb  )  . ( zb ( 14  )  ,x2b  )  ,(zb(  15  )  >x3b  )  , 

A  (zb  06)  ,vlb)  ,  Izbl  17)  ,y2bl  .  ( zb  ( 18  I  ,y3b  )  , 

A  ( zb ( 1 9  I  ,  t ana2b  I  ,  ( Zb ( 20  I  ,  t  ana3b )  ,  I  zb  1 2 1  )  .  t  ana4b  )  , 

A  (zb (22  )  .tanaSb  1  ,  (zb (23  )  ,  tana6b  )  ,( zb  1 24  I  ,  lb  )  .  ( zb (25  )  .phib  ) 

double  precision  coil  .sip  .fret  .c3  ,s4  ,w4  ,x4  ,y4  ,tana7  ,tana8  .1  . 

A  h.phih.rtot  .xtof  .ztot  ,do 

equivalence  (z  (51  )  .coi  1  I  .( z  (52  )  ,s  lp  )  ,  I  z  (53  )  ,  fre  t  )  ,  (z  (54  )  ,c3  )  . 

A  (z  (SS  )  ,s4  )  ,  (z  (56  )  ,w4  )  ,(  z  (57  )  ,x4  I  ,  I  z  (58  )  ,y4  1  , 

A  (z  (59  )  ,  tana7  )  ,  (z  (60  I  ,i  ana8  )  .  ( z  161  )  .1  )  . 

A  (z(62)  ,h)  ,lz(63)  .phihl  , 

A  (z  (64  I  >r  tot  )  , <z  (65  )  ,x  tot  )  .  ( z  (66  )  .ztot  )  ,  ( z  167  )  ,do  ) 

double  precision  snphih  .esphih  .snafh  .esafh  .tnafh  .scafh 
common  /VHDIR/  snphih  .esphih  .snafh  .esafh  .tnafh  .scafh 


O 

M 


/( 


et  sys  f mal/t2for/csshp  forM 
subrou t i ne  CSSHP 

************************************************************************ 

implicit  inleger*2  (®) 
implicit  double  precision  (a-z) 

in t eger*2  I  leg  ,is t  ,nca  .neb  ,n»a  ,nwb  ,  i  so  1  , ibrnch  ,uz  (5  I 
double  precision  z (67  )  ,cz  ,cx  ,d  i ta  , tb 

common  /VCLOB.'  i  leg  list  inca  .neb  ,z  ,cz  .ex  ,d  ,ia  ,tb  ,n»a  >n»b  , 

A  isol  i ibrnch  ,uz 
double  precision  za(2S )  .zb (25 ) 
equ i  va  1  ence  I  z  1 1  I  ,za  ( I  )  I  ,  I  z  ( 26  )  .zb  1 1  )  ) 

double  precision  ha  .al a  .va  ,s  1  a  ,« 1  a  .c  1  a  ,s2a  ,»2a  ,c2a  ,s3a  ,»3a  , 

A  xa  ,ya  ,x  la  ,x2a  ,x3a  ,yla  ,y2a  .v3a  . 

A  t  ana2a  ,  t  anaSa  .  t  anala  .  t  anaSa  ,  t  ana6a > 1  a  ,ph i a 
equivalence  Izad  )  ,ha)  .  I  za(2  I  ,ala  ,val  . 

A  ( za  1 3  )  ,s  1  a  1  ,  ( za  ( 1 )  ,«r  I  a  )  ,  ( za  ( 5  I  ,c  I  a  I  , 

A  <za(6l  ,s2al  .(za(71  ,w2a  I  ,  ( zo  ( 8  I  ,c2a)  , 

A  lza(9  I  ,s3a  I  ,  I  za  ( 1 0  1  ,*3a  I  ,  ( za  I II  )  .xa  )  ,  1  zai  1  2  t  ,ya  )  , 

A  ( za  1 1  3  l  ,x  1  a  I  ,  I  za  I  H  I  ,x2a )  ,  l  zal  15  I  .x3a  )  . 

A  (zal  161  .ylal  ,(za(  17  l  ,y2a)  ,(zaM8>  ,y3al  , 

A  (zal 191  ,tana2al  ,(za(20)  .tana3a)  ,lza(2l  )  ,iana1a>  , 

A  ( za 1 22  I  ,  t  ana5a )  ,  ( za ( 23  1  ,  t  ana6a  I  ,  ( za ( 2*  I  .la)  .  I za 1 25 )  ,ph i a ) 
double  precision  hb  .alb  ,vb  .sib  .wlb  ,clb  ,s2b  ,»2b  ,c2b  ,s3b  >w3b  , 

A  xb  ,yb  .xlb  ,x2b  .x3b  .ylb  .y2b  .v3b  . 

A  t  ana2b  .  t  ana3b  ,  t  ana^b  .  t  anaSb  ,  t  ana6b  .  I b  ,ph i b 
equivalence  ( zb(  1  I  ,hb  1  , (zb (2  I  ,al b  ,vb  1  , 

A  ( zb 1 3  l  ,slb  1  . (zbM  I  .wlb)  ,  (zb  (5)  ,c1b>  , 

A  (zb (6  l  ,s2b  1  .  ( zb (  7  1  ,w2b  I  ,(zb(8l  ,c2b  I  , 

A  (zb (9)  ,s3b>  ,  l zb 1 10)  ,»3b )  ,(zbl II)  ,xb)  ,(zb(l2)  ,yb)  , 

A  ( zb  1 1  3 )  ,x  I  b )  ,  l  zb  (  Ml  ,x2b  )  ,  ( zb  ( 1 5  )  >x3b  I  > 

A  ( zb ( 1 6  I  ,y1b>  ,(zbM7)  ,y2b  I  ,lzbH8>  ,y3b)  , 

A  ( zb  119)  .tona2b  I  . (zb (20  l  ,tana3b  )  .(zb (2 1  I  .( ana^b  )  . 

A  (zb (22  I  ,  t  anaSb I  ,(zb(23l  ,tana6bl  ,(zbl2*)  ,|bl  .  I  zb (25 1  .phibl 
double  precision  coi  1  ,slp  .fret  ,c3  ,si  >»*  ,x*  ,yi  ,tana7  ,  tanaB  .1  , 

A  h.phih.rtot  .xtot  ,ztot  .do 

equivalence  ( z ( 5 1 )  ,coi 1 )  ,(z(52)  .sip)  ,(z(53)  ,frct )  ,  Izl51 >  ,c3)  , 

A  (z(5S)  ,s4)  ,(z(56)  )  ,lz(57  )  ,x1  )  ,(zl58)  ,y^  )  , 

A  (z  (59  1  ,tana7  I  ,  (z  (60  I  >tana8  )  .  ( z  (61  )  >1  )  > 

A  ( z  (62  )  ,h)  ,  ( z  ( 63  )  ,phih)  , 

A  ( z  ( 64  I  ,rtot  I  .  ( z  ( 65  )  ,xtot  )  ,  ( z  ( 66  )  ,ztot  )  >lz(67)  ,do ) 


double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  >hal  f 


II 


I 


io5 


integer*2  i zero  , tone > 1 1  wo 

common  /VCONST/  pi  ,hal  f p i  ,degr ad  .raddeg  .zero  tone  ,hel  1  , 

4  i zero  1 1 one >1  two 

double  precision  rnaf  ,phi 1 
common  /VOFLR/  tnol.phil 

double  precision  delyk  ,twod  ,bal Id ,dsq 
common  /VANCH/  delyk  ,twod  .hal fd  ,dsq 

integer*?  iscopa  , iscopb  ,i tana  ,1 tanb  ,ie 
double  precision  epsy.gamma.se 

common  / VCMPD/  epsy  .gamma  .se  .  i scopa  > i scopb  .  i t ana  ,  i t  anb  .  i e 

double  precision  sa  ,sb  ,ca  .cb  ,vc0a(6  I  ,vc0b(6 )  , 

4  eex0  ,eez0  ,eey0  ,a0  ,b0  ,ph  1 00  ,ph  i  b0 
mteger*2  icase 

common  /VSPIQ/  sa  ,sb  .c a  ,cb  ,vc0a  ,vc0b  . 

4  eex0  ,eez0  ,eey0  ,a0  >b0  ,ph  i  a0  .ph  i  b0  , 

4  icase 

double  precision  snphih  ,csph ih  ,snaf h  .esafb  , i nafh .scalh 
common  /VHOIR/  snph ih  ,csph i h  .snalh  .esafb  , tnalh  , scafh 

double  precision  htnalh  ,hwA  ,wAh  .sAwAh  ,c3h 
common  /VHVEC/  htnalh  ,hw4  ,w4h  ,s^w4h  ,c3h 

integer*?  itani 

double  precision  a.b.snphi  , tnafa  . tnafb  , 

4  seca7  ,seca8  ,ut  ,st  .ykt  ,zkt  ,eex  ,eez  ,eey  .ybuoy 
common  /VCSSHP/  a.b.snphi  .  tnafo  ,  tnafb  . 

4  seca7  ,seca8  ,ut  ,st  .yk  t  ,zk  t  ,eex  ,eez  ,eey  .ybuoy  ,i  tent 

integer*2  ivs 

double  precision  v0  ,vl  ,v2  .10  .11  ,12  ,1  >eps 
common  /VSEC/  v0  .vt  ,v2  ,10  ,11  ,12  ,1  ,eps  .ivs 

double  precision  xred 

integer*2  isidl  .nerra  .nerrb 

common  /VSTA8/  xred  .isidl  .nerra  .nerrb 

integer*?  isb  ,n«  .ntest  ,nerr 

«tt*t»t***f**ttt*****t*t**tt**«*«***ttt***«t«tt**t**tt**t***tt*mm*t* 


o 


I 


/06 


epsy-do* 1  0d-10 
i bench- 1 
ieb-0 

nw-0 


1  f 

(nwa 

eq  0 

and 

nwb 

eq  0) 

goto 

500 

nw- 

1 

i  f 

(nwa 

eq  1 

and 

nwb 

eq  1  ) 

goto 

1000 

i  f 

(nwb 

eq  1  1 

ibrnch-2 

goto  3000 

************************************************************************ 

*  Determine  the  number  of  branches  under  tension 

*  when  junction  lies  on  ocean  floor 

************************************************************************ 

500  coni inue 

******************************************** **************************** 

*  If  branch  lengths  differ  by  more  than  distance  between  anchors, 

*  then  one  branch  is  under  tension 

************************************************************************ 

if  licose  eq  1)  goto  2000 

************************************************************************ 

*  If  load  is  directed  outside  angle  formed  by  branch  extensions, 

*  then  one  branch  is  under  tension 

************************************************************************ 

if  ( ph i h  It  ph i a0  or  ph i h  g  t  ph i b0  )  goto  2000 

************************************************************************ 

*  Both  branches  are  under  tension  if  junction  lies  cn  ocean  floor 

*  Assume  this  to  be  the  case,  with  branches  forming  a  triangle 

*  Calculate  buoy  elevation  when  junction  is  just  lifted  off  floor 

************************************************************************ 

phia-phia0 

phib-phib0 

call  HSPL1T 

tano7- (c3+ha*  tnafa+hb*  tnafb l/h 

call  TRISR 

ybuoy-eey0*y1 

if  (ybuoy  It  do)  goto  1200 

************************************************************************ 

*  Computed  buoy  elevation  is  no  less  than  water  level  , 

*  therefore  junction  lies  on  ocean  floor 

*  Calculate  riser  displacements  and  angles  directly 

O 

ON 


I 


/O  7 


************************************************************************ 

call  SRISRIeeyB  ,one ) 
call  TSPLIT 

call  JUNCT ( tnafa  , tna fb  ,0 1 

eex-eex0 

eez-eez0 

isol-1 

goio  5000 

************************************************************************ 

*  Computed  buoy  elevation  is  less  than  eater  level  > 

*  therefore  junction  lies  above  ocean  floor 

*  Test  each  branch  for  plane  solution  before  searching  for  solution 

*  in  three  dimensions,  shorter  branch  is  first  to  be  tested 

************* ********************************************* ******** ****** 

1200  continue 

if  Isa  at  sb  I  ibrnch-2 
goto  3000 

************************************************************************ 

*  One  branch  is  under  tension  if  junction  lies  on  ocean  floor 

*  This  is  true  for  one  for  two  reasons,  as  indicated  by  index  'icose' 

*  lif  branch  lengths  differ  by  more  than  distance  between  anchors 

*  2  if  load  is  directed  outside  angle  formed  by  branch  extensions 

*  Assume  that  junction  lies  on  ocean  floor 
************************************************************************ 

*  Determine  index  'ibrnch'  of  branch  under  tension  1  for  A  ,  2  for  B 

************************************************************************ 

2000  continue 

if  (icase  ne  I)  goto  2010 
if  (sa  gt  sb 1  ibrnch-2 
goto  2015 
20 1 0  con  1 1 nue 

if  (phih  gt  phibl  ibrnch-2 
2015  continue 

************************************************************************ 

*  Set  parameters  for  branch  under  tension 

*  Calculate  buoy  elevation  when  junction  is  just  lifted  off  ocean  floor 

************************************************************************ 
call  E8U0Y 

if  (ybuoy  It  do)  goto  2200 

************************************************************************ 

*  Computed  buoy  elevation  is  no  less  than  water  level  . 

*  therefore  junction  lies  on  ocean  floor 


O 


/ 


*  Calculate  riser  displacements  and  angles  directly 

************************************************************************ 
call  SR  I  SR ( eey  ,one ) 
call  JTEN(la) 
ib-zero 

i f  ( ibrnch  eq  II  goto  2110 
ib- 1  a 
la-zero 
2110  coni inue 
gamma* p  i 
eex-s  t  *csafh 
eez-zk i +eex*snphih 
eex-eex*csphih 
i so  1-2 

?olo  S000 

*********************************t******************t******tt**t* 

*  Computed  buov  elevation  is  less  than  water  level  . 

*  therefore  junction  lies  above  ocean  floor 

*  Test  each  branch  for  plane  solution  before  searching  for  solution 
*  in  three  dimensions,  beginning  with  branch  currently  assumed  to  be 
*  under  tension 

t*t*t****t***t**t****t*t**t*ttt*t*tt*tt*t**ttt**tttttt***ttt.tttttt*ttt*t 

2200  corn  mue 
ieb-1 

************************************************************************ 
*  Possibility  of  junction  on  floor  has  been  eliminated 
*  For  each  branch,  find  solution  in  vertical  plane  of  loading  force, 

*  and  compute  straight  - 1  me  distances  for  other  branch 

************************************************************************ 
3000  continue 
ntest-1 
3010  corn i nue 

if  1 i eb  eq  II  goto  3100 
call  EBUOY 

if  tnw  eq  0  and  ybuoy  gt  do  I  goto  3500 
3 1 00  con  1 1 nue 

if  t ibrnch  eq  21  goto  3150 

cal  I  SCOIL  (nca  ,za  >vc0a  ,ca  ,nwa  ,ncb  ,zb  ,vc0b  ,sb  ,nerr  ) 
goto  3200 
3150  coni  mue 

col  1  SCOIL  (neb  ,zb  ,vc0b  ,cb  ,nwb  ,nca  ,zo  ,vc0a  ,so  ,nerr  1 
3200  continue 


10*? 


if  (nerr  eq  0  and  coil  ge  zero)  goto  3600 
************************************************************************ 

*  No  possibility  of  plane  solution  in  current  tension  branch 

*  Either  depth  is  insufficient  (from  subroutine  EBUOY » 

*  or  other  branch  is  too  short  (from  subroutine  SC01L  I 
************************************************************************ 

3500  continue 

if  (ntest  eq  2  or  nw  eq  I )  goto  1000 

ibrnch-3- i bench 

ntest-2 

ieb-0 

?oto  3010 

***************************************************************** 

*  Solution  in  plane  of  loading  force  is  consistent  with  length  of 
*  other  branch 

************************************************************************ 

3600  continue 
isol-3 
goto  5000 

************************************************************************ 

*  Solution  must  be  three-dimensional  with  junction  above  ocean  floor, 

*  solve  by  iteration  over  sides  a  .b  of  horizontal  triangle 

************************************************************************ 
1000  continue 

call  STEFAB 

coll  JUNCT (za( i tana  1  ,zb l i tanb )  ,11 
eex-xa*dcos (ph i a  1 
eez-hal fd+xa*ds m (ph i a  1 
i sol -1 

************************************************************************ 
*  Final  computations  for  all  solution  types 
************************************************************************ 
S000  con  1 1 nue 

gammo-dexp (gamma* fret ) 

x  tot-eex+xlfcsphih 

z  tot -eez  +  xl*8nphih 

r  to t -esphi h*x  tot ♦snph jh*z  t  o  t 

return 

end 

* 


O 

-0 


ei  sys  f inal / t2for/phiab  forM 

subroui  me  PHlABIa  ,b  .aambb  ,dsq  ,  twod  >phia  ,phib) 

tt *********************************************** *********************** 

implicit  double  precision  (a-zl 

double  precision  a  ,b  , aambb  ,dsq  , i mod  ,phi a  ,phi b 

double  precision  pi  .halfpi  , degrad  .raddeg  .zero  ,one  ,ha 1 f 
integer*?  i zero > i one  , i t wo 

common  /VCONST/  pi  ,hal  fpi  .degrad  .raddeg  .zero  .one  ,hol  f  , 

4  i zero  , tone  . 1 1 «o 
********************************** 

phia-dacos ( <dsq*aambb 1/ (a* t wod I  I -hal fpi 
ph i b-ha I fpi -dacos ( ( dsq- aambb I / ( b*  t  wod ) ) 
return 


ei  sys  f inal / i2 for/hspl i 1  fort! 
subrou l i ne  HSPL I T 

implicit  double  precision  (a-zl 

i n i eaer*2  i  leg  , i s  I  ,nca  ,ncb  ,n«a  ,n»b  ,i  so  1  , 1  bench  ,uz  15  ) 
double  precision  z  (67  1  ,cz  ,cx  ,d  , t a  ,t b 

common  /VCLOB/  i  leg  ,isl  ,nca  ,ncb  >z  ,cz  ,cx  ,d  iia  ,lb  ,n»»a  ,n«b  , 

4  i  so  1  ,  i  bench  ,uz 
double  precision  za 1 25  1  ,zb 125 ) 
equ  i  va  1  ence  1  z  1  1  1  >za  1 1  1  I  ,  1  z  1 26  I  ,zb  11)1 

double  precision  ha  ,al a  ,va  ,s  1  a  ,w  1  a  ,c  1  a  ,s2a  ,»2a  ,c2a  ,s3a  ,»3a  , 

4  xa  ,ya  ,x  1  a  ,x2a  ,x3a  ,y  1  a  ,y2a  ,y 3a  , 

4  tana2a  ,  i ana3a  ,  t  anaia  1 1 anaSa  1 1 ana6a  ,1a  ,phi a 
equivalence  (zal 1  1  ,ha 1  ,  l za!2 I  ,al a  ,va  I  , 

4  ( zal  3  1  ,sl  a  1  , 1  za  M  I  ,»1  a  1  ,  (za  (5  I  ,da  I  , 

4  ( zal 6  1  ,s2a  I  ,  1  zal  7  I  ,«2a  1  ,  (za  (9  1  ,c2a  I  , 

4  ( zal 9  l  ,s3a  l  ,  (za  ( 10  1  ,w3a  I  ,  (za  (  I  I  I  ,xa  )  ,  Iza  (  1 2  I  ,ya  )  , 

4  1  za  1  I  3  l  ,x  1  a  )  ,  1  za  1  M  1  ,x2a  I  ,  1  za  (  1 5  1  ,x3o  )  , 

4  1  za  1  1 6  I  ,y  1  a  I  ,  1  za  1  1  7  1  ,y2a  I  ,  1  za  1  18  1  ,y3a  )  , 

4  1 za 1 1 9  l  ,  i ana2a  1  , 1 za 1 20  1  ,  t  ana3a  1  , 1 za ( 2 1  I  ,  i ana^a  )  , 

4  1 za 1 22  l  ,  i ana5a  I  ,  1 za 1 23  1  ,i ana6a  1  , 1 za 1 24  )  ,  1  a  I  ,  l za i 25  )  ,ph i a  I 

double  precision  hb  ,a1b  ,vb  ,slb  ,wlb  ,ctb  ,s2b  ,*2b  ,c2b  ,s3b  ,*3b  , 

4  xb  ,yb  ,x  I  b  ,x2b  ,x3b  ,y  I  b  ,y2b  ,y3b  , 

4  i ana2b  ,  i ana3b  ,  l ana3b  ,  i anaSb  ,  i anabb  ,  I b  ,ph i b 
equ  i  valence  1  zb  1  I  )  ,hb  1  , 1  zb  1 2  )  ,alb  ,vbl  , 

4  ( zb  (  3  I  ,s  1  b  )  ,  1  zb  M  )  ,w  1  b  I  ,  I  zb  ( 5  I  ,c  1  b  )  , 

4  1  zb  (6  I  ,s2b  1  , 1  zb  1  7  )  ,w2b  I  ,lzbl8l  ,c2b  I  , 

4  1  zb (9  )  ,s3b  )  ,  1  zb  1  1 0  )  ,w3b  I  ,  1  zb  1  1  1  I  ,xb  )  ,  1  zb  1  1  2  I  ,yb  )  , 

4  (zbl  1  3  )  ,xlb  I  ,  1  zb  l  M  1  ,x2b  1  ,  (zbl  15  I  ,x3b  )  , 

4  (zbl 16  )  ,y1b  I  , (zbl 1 7  I  ,y2bl  , ( zb ( 1 8  1  ,y 3b  )  , 

4  ( zb ( 1 9  1  ,  tana2b I  ,  ( zb ( 20  1  ,  i ana3b I  ,  ( zb ( 2 1  I  ,  ( ana4b  1  > 

4  ( zb ( 22  I  ,  l ana5b  I  > (zb (23  )  ,  ( ana6b I  ,  I  zb ( 23  >  ,  1 b  I  ,  I  zb  1 25  t  ,ph i b 1 

double  precision  coi  1  ,slp  ,frci  ,c3  ,s4  .wl  ,x1  ,y*  ,iana7  ,iana8 ,1  , 

4  h,phih,rtot  ,xto!  ,zloi  ,do 

equ i valence  ( z ( 51  )  ,co il  )  ,(z(52l  ,slpl  ,(z(53)  ,(rcr  )  ,  I z  <  54  )  ,c3)  > 
4  ( z  ( 55  )  ,s4  )  1 1  z  ( 56  1  ,w4  1  ,(z(57l  ,x4  )  ,(z(58)  ,y4  >  , 

4  ( z  ( 59  I  ,  t  ana  7  )  ,  ( z  ( 60  1  ,  i  ana8  I  ,  l  z  ( 6 1  1  ,1  )  , 

4  ( z  (62  )  >h  I  ,  (z  (63  )  ,phihl  , 

4  (z(6-1l  ,rrot  1  >  ( z  (65  1  ,xto(  I  ,(z(66t  ,z(o(  )  ,(zl67l  ,do) 

double  precision  inaf  ,phi f 
common  /VOFLR/  inaf  ,phif 


double  precision  a  ,b  >snphi  ,inafa  ,mafb  , 

4  seca7  ,seca8  ,ut  ,sl  ,yk  t  ,zk  l  ieex  ,eez  ,eey  ,ybuoy 
common  /VCSSHP/  a,b,snphi  ,  ina  fa  ,  mafb  » 

4  seca7  ,seca8  iut  ,st  ,yk  t  ,zk  l  ,eex  ,eez  ,eey  ,ybuoy 

snphi -ds i n (ph i b-ph la ) 
ha-h*ds in (phib-phih  J/snph i 
hb-h*dsm(phih-phia  I /snphi 
tnafa-dcos (ph i a-ph i f l*inaf 


II 


et  svs  f  mal/t2for/lr  isr  for## 
subrou  tine  TR I  SR 

***** ******************************************************************* 
implicit  double  precision  (a-z I 

mleger*2  i  leg  ,ist  ,nca  ,ncb  ,n»a  ,n«b  ,isol  .ibrnch  ,uz  IS  ) 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,  ta  .tb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,ta  ,tb  >n*a  ,n»b  , 

A  i sol  .ibrnch  ,uz 
double  precision  za (2S  I  ,zb ( 25  ) 
equ  i  va  1  ence  ( z  ( I  )  ,za  ( 1  1  I  ,  ( z  1 26  )  ,zb  1 1  II 

double  precision  ha  ial  a  ,va  ,s  t  a  .•  I  a  ,c  I  a  ,s2a  ,w2a  ,c2a  ,s3a  ,w3a  , 

A  xa  ,ya  ,xla  ,x2a  ,x3a  .yla  ,y 2a  ,y3a  i 
A  tona2a  ,tana3a  .tanala  ,tana5a  ,tana6a  ,la  ,phia 
equ  i  va  I  ence  ( za  (  I  I  ,ha  I  •  ( za  1 2  I  ,a  I  a  ,  va  I  , 

A  ( za  I  3  I  ,s  I  a  I  ,  <  za ( 1 1  ,« I  a  I  ,  I  za  I S  I  ,c  1  a  I  , 

A  (za(6l  ,s2a)  ,(za(7l  ,*2a)  ,(za(8l  ,c2a)  , 

A  (za  (9  I  ,s3a  )  ,  (za<  10  )  ,»3a  I  ,  ( za  1 1  I  )  ,xa  I  ,  ( za  ( 1 2  )  ,ya  I  , 

A  ( za ( 1  3  I  ,x  1  a  I  ,  1  za (  M  I  ,x2a  I  ,( za(  IS  I  ,x3a  I  , 

A  (za(  16  I  ,y  I  a  1  ,( za  ( 1  7  I  ,y 2a  I  ,( za  I  18  I  ,y  3a  I  , 

A  I za( 19  I  ,  tana2a  I  ,  ( za  1 20  I  ,  i ana3a I  ,  I za 121  I  ,  i anala  I  , 

A  ( za ( 22  I  ,  t  ana5a  I  ,  ( za ( 23  I  ,  t  ana6a  I  ,  ( za 1 21  I  ,  I  a  I  ,  ( za ( 25  I  ,ph i a ) 

double  precision  hb  ,a1  b  ,vb  ,s  1  b  ,» lb  ,c  I  b  ,s2b  ,*2b  ,c?b  ,s3b  ,<*3b  , 

A  xb  ,yb  ,xlb  ,x2b  ,x3b  ,ylb  ,y2b  ,y3b  , 

A  I  ano2b , t  ana3b , t analb  ,  t  anaSb  ,  i ana6b  ,  I b  ,ph i b 
equ  i  va  I  ence  I  zb  I  I  I  ,hb  I  ,  I  zb  ( 2  1  ,a  I  b  ,vb  I  , 

A  ( zb  1 3  I  ,s  I  b  l  ,  l  zb  HI  ,w  I  b  I  ,  ( zb  I S  I  ,c  1  b  I  , 

A  ( zb  (6  l  ,s2b  l  ,  I  zb  (  7  I  lW2b  I  ,  I  zb  1 8  I  ,c2b  I  , 

A  I  zb  (9  I  ,s3b  l  ,  I  zb  1 10)  ,«3b  i  .izblll  I  ,xbi  ,  Izbl  12)  ,yb)  , 

A  Izbl  131  ,xlbl  ,(zb(Ml  ,x2bi  , ( zb 1 15  I  ,x3b  )  , 

A  lzb(  16  I  ,y1b  I  ,(zb(  17  I  ,y2b  I  ,(zbl  18  I  ,y3b  )  , 

A  (zb  1 19  I  ,  tana2b I  ,  ( zb<  20  I  , tana 3b  I  ,  ( zb (21  I  , t  analb )  , 

A  ( zb (22  I  ,  t  ana5b  I  ,  I  zb ( 23  I  ,  i ana6b  I  ,  I  zb ( 21 )  ,lbi  , izbl 25)  ,ph i b  ) 

double  precision  coi  I  ,slp  ,frct  ,c3  ,s1  ,»1  ,x1  ,yl  ,iana7  ,tana8  ,1  , 

A  h  ,ph i h  ,rtol  ,xlot  ,zlot  ,do 

equ i valence  I z (5 1  )  ,co il  I  ,(z(52i  .sip)  ,(ziS3)  ,frct  I  , ( z 151 )  ,c3)  > 

A  (z(55  I  ,s1  I  ,(z(56  I  ,«1  I  ,lz  157  I  ,»1  i  ,(z  158  I  ,y1  )  ■ 

A  ( z ( 59  I  ,  t ana  7  1  ,  ( z ( 60  I  ,  t  ona8  I  ,  ( z 1 6 1  I  .1  I  , 

A  ( z  1 62  I  ,h  I  ,  I z  (63  I  ,phih  I  , 

A  I  z  (61 1  ,rtoi  I  ,  ( z  165  I  ,x  t  o  t  I  ,  I  z  1 66  I  ,z  t  o  t  I  ,  ( z  1 67  I  ,do  I 


double  precision  htnafh  ,h*1  ,*1h  ,s1»1h  ,c3h 
common  /VHVEC/  htnafh  ,ht»1  ,«1h  .glvl1,  ,c3h 


I 


nv 


double  precision  a,bisnphi  .rnafa  ,tnafb  , 

A  seco7  ,seco8  ,uf  ,si  ,ykt  ,zk  l  ,eex  ,eez  ,eey  ,ybuoy 
common  /VCSSHP/  a  ,b  ,snph i  ,  tna  fa  ,  mafb  , 

4  seca7  ,seca8  ,ut  ,st  ,ykt  ,zki  ,eex  ,eez  ,eey  .ybuoy 
ttttttt*t*t*t*t**t******%ttt****t*t**t**t****t*ttt%tt*t**t*.*tttttt***tt* 
i ana8- i ana7  +  s4t*4h 
col  1  SCA7A8 
y1-hw4* (seca8-seca7 1 
return 
end 

* 


ei  sys  f inal/i2for/sca7a8  forM 

implicit  double  precision  <a-z> 

integer*2  i  leg  ,isl  ,nc a  ,ncb  ,n*a  ,n«b  ,isol  .ibrnch  .uz(S  > 
double  precision  2 (67  )  ,cz  ,cx  ,d  ,  <  a  , lb 

common  /VCLOB/  1  leg  ,  1  s t  ,nca  ,ncb  ,2  ,cz  ,cx  ,d  ,  1  a  > lb  ,n«.a  ,n«rb  , 

&  1  sol  .ibrnch  ,u2 

double  precision  za ( 25  J  J  .... 

equivalence  ( 2  ( 1  )  >za ( I  I  )  ,  ( z  < 26  I  ,zbt  1  >  )  ,0,,  -z. 

double  precision  ha  »olo  »va  >s1  a  »*l o  »c1  d  »s2a  »*2o  »c2o  iS5o  »w3o  » 

A  xa  ,ya  ,xla  ,x2a  ,x3a  .y  la  .y2a  ,y3a  , 

A  1 ana2a  .  1 ana3a  ,  1 ana la  .  1 ana5a  .  *  anaoa  > 1  a  .ph 1  a 
equivalence  (zall  I  ,ha  1  .<za(2l  .ala  ,va>  , 

A  (za(3)  ,sla)  ,(zaMl  .olai  .<za(Sj  ,cla  , 

A  lza(6i  ,s2a  I  ,(za(7l  ,«2al  ,<za<8)  ,c?al  . 

A  (za(9  )  ,s3a  I  .izal  10)  ,»3a)  ,  I  za  Ml  I  ,xa)  ,lzall2  )  .ya)  . 

A  Izal  1 3  I  .xla  I  ,(za(  M  I  .x2a  1  ,(zal  15  )  ,*3a )  , 

A  (za(16l  ,yla)  ,(za(l7l  ,y2a)  .(za(l8  ,y3al  , 

A  (2a< 19)  ,iana2al  ,(za(20  I  .iana3a I  ,lza(2l  )  .'ana^aJ  , 

A  izal 22)  , I anaSo )  ,  Izal 23)  ,tana6al > 1  z° ' J  a  ' 1  ’  'pbi?  1 

double  precision  hb  >alb  »vb  .sib  ,w1b  ,db  >s2b  »*2b  »c2b  .s5b  ,*5o  . 

A  xb  ,vb  ,xlb  ,x2b  ,x3b  .y lb  .y2b  .y5b  , 

A  1 ana2b  ,  1 ana3b  ,  1 ana4b  .  1 ana5b  .  1 anaob  ,  I b  ,pn 1 b 
equivalence  l  zb  1 1  I  ,hb  )  ,lzb(2  )  ,alb  .vb  )  . 

A  ( zb  1 3  1  .slbl  ,  ( zb  M  I  .«rlbl  .(zblSl  ,clb)  , 

A  (zb  16)  ,s2b>  ,(zb(7l  ,»2b  I  , l zt> 1 8  1  ,c2b  I  , 

A  l  zb  (9)  ,s3b  )  ,  l  zb  ( 1 0  )  ,»3b  I  .  I  zb  1 1  I  )  ,xb  )  ,  I  zb  1 1 2  )  >yb  )  . 

A  I  zb  1 1  3 )  ,x  1  b  )  ,  ( zb  l  M  )  >x2b  I  ,  ( zb  1 1 5  )  ,x  3b )  . 

A  ( zb  1 1 6  I  ,v  1  b  )  ,  l  zb  1 1  7  )  ,y2b  )  ,  l  zb  1 1 8  )  ,y  3b  >  . 

A  lzbll9l  ,iana2b)  ,(zb(20l  ,'ana3bl  ,<zb(2M  ,iana<b)  , 

A  (zb (22)  ,  1 ana5b 1  ,  l zb 1 23)  ,iana6b)  ,lzb 12* 1  ,1b  )  ,  ( zb (25  )  >Pb  ‘  6  1 
double  precision  coil  ,slp  ,frci  .c3  ,s4  ,»4  .*4  ,y4  ,tano7  ,tana»  .1  . 

A  h  ,phih  ,r  101  ,xioi  ,zioi  .do  (tl, 

equivalence  tz  (5»  I  .coil  I  ,(z(52)  .sip)  •  <Z<S3)  ,frct  )  .  I  z  ( S-4  )  ,c3)  . 
A  (z  155)  .si)  ,  l  z  1 56  )  ,»4>  ,(z(57l  ,x4  )  ,lzl58)  .y4  )  . 

A  (z(59)  ,tana7l  ,(z(60)  ,iana8l  ,(z(61)  ,1  )  . 

A  (2(62)  ,h)  ,(z(63l  .phihl  ,  lR7.  .  . 

A  (z (64  )  .riot  I  ,  (z(65)  ,xioi  I  .!z(66>  ,ziot  )  ,lz(67)  ,do) 


double  precision  o  .b  .snphi  ,mafa  .inafb  . 

A  seca7  ,seca8  ,ui  .si  »y k  1  ,zk  1  ,eex  ,eez  ,eey  .ybuoy 


. tl  - 

seca?-SECNT I tana? ) 
seca8-SECNT(tane8) 


return 

end 
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e>  sys  f inal/i2for/snsr  forM 

subroutine  SRISRIey  .1  fact  I 

************************************************************************ 

implicit  double  precision  (a-z) 

double  precision  eyilfact 

in  teger*2  i  leg  ,  i  s  l  ,nca  ,ncb  ,n»a  ,nwb  ,  i  sol  ,  ibrnch  ,uz  15  ) 
double  precision  z  (67  I  ,cz  ,cx  ,d  >  t  a  .  f  b 

common  /VGLOB/  i  leg  , i s  f  .nca  .neb  .z  ,cz  ,cx  ,d  ,  ra  ,  tb  ,n«ra  ,n*b  , 

A  iso  I  ,ibrnch,uz 
double  precision  zal  25  I  ,zb(25 ) 
equ  i  va  1  ence  ( z  ( II  ,za  ( I  I  I  ,  ( z  ( 26  I  ,zb  ( 1  )  ) 

double  precision  ha  ial  a  ,va  ,s1  a  ,w I  a  iC  I  a  >s2a  ,»2a  >c2a  ,s3a  ,w3a  , 

A  xa  .ya  .xla  .x2a  ,x3a  .yla  .y2a  .y3a  . 

A  t  ana2a  .  t  ana3a  ,  t  ana4a  >  t  anaSa  >  t  ana6a  ,  1  a  iph i o 
equivalence  (gat  I )  ,ha I  .(za(2)  .ala .va)  , 

A  (za(3)  ,slal  , (zaM)  ,wlal  ,(za(5l  >cla)  , 

A  (za(6l  .s2al  ,(za(7l  ,«2a )  ,(za(8)  .c2al  . 

A  (  za  (9  )  .s3a  1  ,  ( zal  10  1  ,»3a  I  ,  ( za(  H  I  ,xa  I  ,  ( za  1 1  2  I  .ya  I  , 

A  (zal  1  3  l  ,x  I  a  I  .( zal  I  3  I  ,x2a  )  .  ( za  <  15  )  ,x3a  I  , 

A  (za(  16  I  .y  1  a  ),( zal  I  7  I  ,y2a  I  .  (za(  1 8  1  ,y3a  I  , 

A  (zal 19  I  ,  tana2a)  .(zal 20)  ,tana3al  >(za(2l  I  .  tana4a)  . 

A  I zal 22  I  ,tana5a I  ,  I zal 23  )  ,tano6a )  > ( za 124  )  .  1  a  I  ,  I zal 25  >  ,phia ) 
double  precision  hb  .a I b  ,vb  ,s I  b  .w  1  b  ,c lb  ,s2b  ,*2b  ,c2b  .s3b  ,«*3b  , 

A  xb  .yb  .xlb  .x2b  .x3b  .ylb  ,y2b  ,y3b  , 

A  t  ana2b  .  t  ana3b . t  onq4b  .  t  ana5b  ,  t  ana6b  ,  1 b  >ph i b 
equ  i  va  I  ence  I  zb  1 1  )  .hb  )  .  I  zb  1 2  I  .alb  .vb  I  , 

A  I  zb  1 3  1  ,s  I  b  I  ,  ( zb ( 4  1  ,w  I  b  I  ,  I  zb  ( 5  I  ,c  1  b  I  , 

A  ( zb (6  )  ,s2b )  ,  ( zb ( 7  I  ,»2b  )  , (zb  (8  I  .c2b  )  , 

A  I  zb  (9)  ,s3b  l  ,  l  zb  ( 10  )  ,«3b)  ,  I  zb  1 1  1  )  .xb  1  , 1  zb  1 1 2  1  >yb  )  , 

A  I  zb  1 1 3  I  .xlb )  ,  (zb  1  14  1  >x2b  I  .  ( zb  (151  >x3b )  > 

A  (zb 1 16  I  .ylb)  ,(zb(  17)  ,y2b  I  . (zbl  18  )  ,y3b  )  , 

A  I  zb  1 1 9 )  ,  t  ana2b  1  , 1  zb  ( 20  I  ,  t  ana3b  1  , 1  zb  1 2 1  )  .  t  ana4b  )  . 

A  I  zb  1 22  )  .  tanaSb  1  .  (zb (23  1  .  t ana6b  I  .  I  zb (24  I  ,  lb  I  .  I  zb (25 1  ,phib  ) 
double  precision  coi  I  .sip  .fret  ,c3  ,s4  ,»4  ,x4  ,y4  ,tana7  ,  t  ana8  ,1  . 

A  h  ,phih  ,r tot  ,xtot  ,ztot  ,do 

equivalence  (z  (51  )  .coi  1  I  ,  (z  (52  I  .s  Ip  1  ,( z  153  I  ,frc  t  I  ,  (z  (54  )  ,c3  )  , 

A  ( z  ( 55  I  ,s4  I  ,  ( z  ( 56  I  ,e4  I  ,(z(S7l  ,x4  I  ,(z(58)  ,y4  I  . 

A  (z(59)  ,  tana7)  ,(z(80)  >tana8l  .  ( z ( 6 1  1  ,1 )  , 

A  (z(62)  ,hl  , ( z ( 63  1  .phihl  , 

A  (z  (64  I  ,r  tot  I  ,lz  (65  I  .x  tot  I  .  (z  166  1  ,z  tot  )  ,  (z  167  )  ,do  ) 


--a 


double  precision  pi  .halfpi  , degrad  .raddeg  , zero  , one  ,hal f 
mr  eg  er*2  i  zero  ,iOne  ,i  two 

common  /VCONST/  pi  .halfpi  , degrad  ,roddeg , zero  , one ,hal f , 

&  i zero  ,ione  ,  1  two 

double  precision  snphih  .csphih  ,snafh  ,csafh  .tnafh .scafh 
common  / VHOIR /  soph i h  ,csph i h  ,sna fh  ,csa fn  . i nafh  .scafh 

double  precision  hinafh  ,h«A  ,wAh  ,s4*4h  ,c3h 
common  /VHVEC/  htnafh  ,h*r1  ,*4h  ,s4*>4h  ,c3h 
******************************(***********************************«***** 
yl-do-ev 

1  -LENS  (yl  ,csafh  .snafh  ,s4  ,h  l»  1  fact 
if  (1  gt  zero )  goio  20 
1 -zero 

tana7-TANI (s4»1h  ,y1*»4h) 
goto  50 
20  coni  mue 

i ana7- tnafh 
50  com  inue 

iana8-rana7Ms4-l  l*w^h 

call  SCA7A8 

call  X1CAIC 

x^-x4+ 1 *csafh 

re  t  urn 

end 


et  sys  f  mal / 1 2 for/ 1 anl  forM 
f  unc  lion  T  AN  I  ( d  I  >ds  ) 

*tt ********************************************************************* 

*  Computes  tangent  of  the  algebraically  smaller  of  two  angles > 

*  given  the  differences  between  their  tangents  and  secants 

************************************************************************ 
implicit  double  precision  (a-;) 


double  precision  tan  I  ,dt  ,ds 

double  precision  pi  ,hal  fpi  .degrad  >raddeg  .zero  ,one  ,hal  f 
integer *2  i zero >i one .i two 

common  /VCONST/  pi  ,hal  fpi  .degrad  .raddeg  .zero  .one  ,hal  f  , 

A  i zero  ,ione  .1  two 

************************************************************************ 

*  1  an  I  •  1  angen  t  o  f  sma  I  1  er  ang  1  e 

*  dt  -  tangent  of  larger  angle  -  tangent  of  smaller  angle 

*  ds  *  secant  of  larger  angle  -  secom  of  smaller  angle 
************************************************************************ 

1 anl -hal f * (ds*dsqr t (one+1  0d0/ idt  *dt -ds*ds ) ) -dt ) 

return 

end 

* 


-o 


et  sys  ( inal /(2for/xicalc  fort# 
subrout me  X3CALC 

****************************************************************** ****** 

implicit  double  precision  (a-zl 

integer *2  i  leg  ,isi  ,nca  ,ncb  ,n»a  ,n*b  1 1  sol  ,  ibrnch  ,u2  15  ) 
double  precision  2  (67  )  ,cz  ,cx  id  ,  la  ,tb 

common  /VCLOB/  1  1  eg  ,  1  s  t  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,  t  a  ,  t  b  ,n«*a  ,nwb  , 

&  isol  .ibrnch  ,uz 
double  precision  2a (25  1  izb (25 ) 
equivalence  (2(1)  ,za ( I  II  , ( z (26  1  ,2b ( t  )  ) 

double  precision  ha  ,a1  a  >va  ,sl  a  ,w  I  a  ,c  1  a  ,s2a  ,*2a  ,c2a  ,s3a  ,w3a  , 

A  xa  ,ya  ,xla  ,x2a  ,x3a  ,vla  ,y2a  ,y3a  , 

A  t  ana2a  ,  t  ana3a  , » anala  ,  ( ana5a  ,  t  ana6a , 1  a ,ph 1  a 
equ  1  va  1  ence  ( 2a  ( 1  1  ,ha  1  ,  ( za  ( 2  I  ,a  1  a  ,  va  )  , 

*  <za(  3  1  ,sl  a )  ,  (zai  1 )  ,wl  a )  ,  tza(5  1  ,c  I  a )  , 

A  1  za  (6  I  ,s2a  I  ,  ( za  (  7  )  ,w2o  I  ,  ( za  ( 8  )  ,c2a  >  , 

A  (za(9  I  ,s3al  ,(za(  '0>  i«3oi  ,'za< '  1  1  ,xe)  ,'20('?>  ,ya>  , 

A  lza(  1 3  I  .x  la  I  ,(za(  H  I  ,x2a  I  ,  (za  ( 15  1  ,x3a )  , 

A  (za(  16)  ,yla)  ,lza(  17  1  ,y2a )  ,izaH8l  ,y3a  )  , 

A  ( za(  19  I  ,  tana2a  1  , 1  za  1 20  )  ,  tana3a  1  , 1  la (21  )  ,  tana') a  >  , 

A  (za(22  )  ,  tana5a 1  ,  ( za (23  I  ,  tana6a 1  ,  t  za (23 )  ,  1  a  1  , 1 za 1 25  >  ,phi a ) 

double  precision  hb  ,a)b  , vb  ,s  1  b  ,» I b  ,c  1  b  ,s2b  ,«?b  ,c2b  ,s3b  ,«3b  , 

A  xb  ,yb  ,x I b  ,x2b  ,x3b  ,y  lb  ,v2b  ,y3b  , 

A  1 ana2b  ,  t  ana3b  ,  t ana3b  ,  1 anaSb  ,  t ana6b  ,  1 b  ,ph 1 b 
equivalence  (zb(  I  )  ,ht> )  ,  (zb  (21  ,alb  ,vb  I  , 

A  ( zb  ( 3  )  ,s  1  b  )  1  ( zb  ( 4  l  ,w  I  b  I  ,  ( zb  ( 5  I  ,c  1  b  1  , 

A  (zb  (6  1  ,s2b  I  ,(zb(7)  ,*2b  I  ,(zb(8)  ,c2b  I  , 

A  (zb  (9  I  ,s3b )  ,(zb(  10)  ,#3b  )  ,  I  Zb  (111  >xb  I  >  ( 2b  (121  >yb  I  • 

A  (zb(13l  ,xlb)  ,(zbl  13  1  ,x2b  )  ,(zbl  15)  ,x3b  !  , 

A  (zb  (16  )  ,ytb  I  ,(zb(  17)  ,y2b  )  ,  (zb  ( 18  )  ,y3b  )  , 

A  ( zb  ( 1 9  )  ,  t  ana2b  I  ,1  zb  1 20)  ,  t  ana3b  )  ,  1  zb  1 2 1  )  ,  t  ana-t  b  )  , 

A  (zb (22 1  , tanoSb )  > (zb (23  )  ■  tana6b )  , (zb (23 )  ,1b) , t zb (25 ) ,phib ) 
double  precision  coi  1  ,slp  ,f ret  ,c3  ,s3  ,xA  ,y1  ,tana7  ,tana8  ,1  . 

A  h.phih.rtot  ,xtot  ,ztot  ,do 

equivalence  ( z  (51  )  ,coi  1  )  ,  iz  (52  )  ,s  Ip  I  ,( z  (53  )  ,frct  1  ,(z  (53  )  ,c3 )  , 

A  (z  (55  )  ,s3  I  ,(2(56  1  I  ,(z  157  )  ,x1  )  ,  ( z  ( 58  I  .y-4  1  , 

A  (z  (59  I  ,  tana 7  )  ,  (z  (60  I  ,tana8  I  ,  ( z  (6 1  )  ,1  )  , 

A  I z  (62  )  ,h )  ,  !z  (63  )  ,phih )  , 

A  (z  (63  I  ,r  toi  I  ,  ( z  (65  )  ,x  tot  I  ,  (z  (66  I  ,2  tot  I  ,  ( z  (67  )  ,do  ) 

double  precision  htnafh  ,h*A  ,»Ah  ,sAwAh  ,c3h 
common  7VHVEC7  htnafh  ,h*t  ,»3h  ,s^*3h  ,c3h 


I 

111 


er  sys  f inal / i2 for/ ispl i i  fortt 
subroutine  TSPLlT 

******************************************* ******** ********************* 

implicit  double  precision  (a~zl 

i  n  l  eger  *2  1 1  eg  >  i  S  t  ,nca  ,ncb  ,n*a  ,n«b  ,  1  so  I  ,  i  brnch  ,uz  ( 5  ) 
double  precision  2  (67  )  ,cz  .ex  ,d  ,1  a  ,tb 

common  /VCLOB/  i  leg  .  1  s  r  ,nca  .neb  .z  ,cz  ,cx  ,d  ,  t a  ,  tb  ,nwa  ,nwb  , 

A  1  sol  ,  1 brnch  .uz 
double  precision  za(2S  1  ,zb!2S ) 
equ  1  va  1  ence  I  z  1 1  1  ,za  II  11  ,1/12  6  I  ,zb  ( I  I ) 

double  precision  ha  ia1  a  ,va  «s!a  ,*  I  a  ,C  I  o  ,s2a  ,*2a  ,c2a  ,s3a  ,»3a  , 

A  xa  >yo  ,x1a  ,x2a  ,x3a  ,yla  ,y2a  ,y3a  , 

A  t  ana2a , t  ana3a , 1 ana4a  ,  t  anaSa  ■  t  ana6a  .  1  a  >ph 1  a 
equivalence  Izal) )  ,ha )  ,  fza(2>  ,ala  ,va)  , 

A  Izal 3 )  ,s  I  a  1  .  (za(4  I  iw  I  a  I  ,  (za  (S  )  ,c)a>  , 

A  lzol61  .s2ol  1  Izal 7  )  .w2al  , tzaiB)  ,c2a)  . 

A  (za  (9  I  ,s3a  )  ,(za(  10  )  ,w3a  I  ,  (za  ( II  I  ,xa  I  ,  1  za  1 ' 2  )  ,va  )  , 

A  (za(13l  ,xlal  ,(za<14)  ,x2a  I  ,<2attS)  ,x3a)  , 

A  ( za ( 1 6  )  ,y  I  a )  ,  ( za (  1  7  I  ,y2a!  ,(za  I  18)  ,y3a  )  , 

A  (za( 19  )  ,tana2a I  , Izal 20  >  ,  tana3a I  ,  (za(2 1  1  ,  t  onato  1  , 

A  ( za  1 22  1  ,  t  anaSa  )  1  ( za (23  I  ,  t ana6o 1 , ( za 1 24 1  , 1  a  1  , 1 za 1 29  )  ,ph 1  a  1 

double  precision  hb  , alb  .vb  , sib  ,*lb  ,clb  ,s2b  ,*2b  ,c2b  ,s3b  .«*3b  . 

A  xb  .yb  ,xlb  ,x2b  ,x3b  .ylb  .y2b  iy3b  , 

A  1 ana2b  ,  t  ana3b  ,  1 ana4b  ,  t  anaSb  ,  i ana6b  > 1 b  >ph 1 b 
equ  1  va  I  ence  ( zb  ( I  )  ,hb  I  ,  ( zb  ( 2  I  .alb  .  vb  I  . 

A  Izbi3)  ,slb)  1  (zb HI  ,*lbl  ,  <zb<S)  .clbl  , 

A  (zb  (6  I  ,s2b  )  ,  (zb  (  7  l  ,w2 b  I  ,  ( zb  (8  I  ,c2b  I  , 

A  (zb (9 1  ,s3b  I  .(zb<  10  )  ,»3b  I  .  ( zb  (  H  I  .xb  1  ,(zb(  12  1  ,vb  I  , 

A  (zbt  13  I  ,xtb)  ,(zbl  14  I  ,x2b  1  ,(zb(  15  )  ,x3b  )  , 

A  ( zb  (16)  ,y  I  b  l  .  ( zb  (171  ,y2b  I  ,(zbM8  )  ,y3b  )  , 

A  ( zb (19)  ,iona2b  I  . (zb (20  J  , >ana3b )  .  (zb (21  )  , t ana*b )  . 

A  ( zb  (22  I  1 1  ana5b  I  .  ( zb  ( 23  )  ,1  ana6b  I  •  ( zb  ( 24  I  >  1  b  1  .  ( zb ( 25 '  .ph  1  b  I 
double  precision  coj  1  ,s!p  ,frc(  .c3  ,s4  ,*4  ,x4  ,y4  ,tana7  ,tana8  ,)  . 

A  h  ,phih  ,rtot  ,x)ot  ,zrot  ,do 

equi val ence  (z(5l  I  .coil  I  .lz(S2>  .sipl  .(z<53)  .fret  )  ,  I z 1 54  I  .c3)  . 

A  <z<55  )  .s4  )  ,  I  z  156  )  ,w4  1  ,  (  z  157  )  ,x1  )  ,  (z  1 58  I  ■  v •*  I  . 

A  1/(591  ,  tano7 )  ,(2(601  ,  tana8 I > (z (6!  1  ,1  I  . 

A  Izl62>  ,h)  ,lzl63)  .phih)  , 

A  (z  (84  I  ,r  tot  )  1  (z(65  I  .xtoi  I  >  (z  (66  )  ,z  to  r  I  ,  (z  (67  )  ,do  ) 
double  precision  b  ,sinb  .cosb  ,tanb  .seeb 

equivalence  Izl25  >  ,b )  , (z(26  )  ,s mb  1  , ( z 12 7 )  ,cosb )  .  ( z (28 )  , tanb )  . 

A  (z  (29 1  .seeb  ) 


IZZ 


J I 

m 


integer *2  uzl  >uz2  ,uz3  >uzi  ,uz5 

equ  i  va  1  ence  ( uz  ( I  )  ,uz  1  )  ,  ( uz  1 2  )  ,uz2  )  ,  1 uz  ( 3  )  ,uz 3  )  ,  ( uz  (1  )  .uzl )  , 

4  (uz(S),uzSl 

double  precision  pi  ,hal  (pi  .degrad  ,raddeg  ,zero  .one  ,hal  f 
imeger*2  i zero  , i one  , i i wo 

common  /VCONST/  pi  ,hal (pi  , degrad  .raddeg  .zero  .one  ,hal f  , 

4  izero  ,ione  ,i  two 

double  precision  delyk  , i mod  ,hal fd  ,dsq 
common  /VANCH/  de  1  y  k  ,  t  wod  >ha  1  f d  ,dsq 

double  precision  sa  ,sb  ,ca  .cb  ,vc0a ( 6  )  ,vc0b 1 6  )  , 

4  eex0  ,eez0  >eey0  ,a0  >b0  ,phia0  ,phib0 
mteger*2  icase 

common  /VSP1D/  sa  .sb  ,ca  .cb  ,vc0a  ,vc0b  , 

4  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0  , 

4  icase 

double  precision  snphih  .esphih  .snafh  .esafh  ,mafh  .scofn 
common  /VHDIR/  snph i h  ,csph i h  ,sna f h  ,csa fh  ,  I  no ( h  ,sca f h 

equivalence  (czsql  .ddsq  .phibb  ,eex  I  ,  I f  x  .phihh  ,eez  )  , 

4  I  f z  ,dd  ,snph i  i  ,eey  !  ,  (ph i aa  .gamma  I 

tt*tt*tt«t***t*tttt*ttt**t******tt**t*t*t**t**t**»****t******tt**t***t*t 

czsql -cz*cz+one 

f  x -czsql *csphib'cx*cz*snph ih»cx*  f na fh 
f  z-snph  ih«-cz*  I  na  fh 
if  Ifx  ne  zero)  goto  20 
if  I fz  It  zero  I  goto  10 
phihh-hal fpi 
goto  15 
10  coni inue 

phihh-  -halfpi 
1 5  cont inue 
goto  50 
20  cont inue 

phihh-da  tan  I dsqr  t(cx*cx*czsql  l*fz/fx) 

50  cont inue 

ddsq-dsq»czsql 
dd-dsqr  t (ddsq 1 

call  PHI  A8 1  sa  .sb  >sa*se-sb*sb  ,ddsq  ,dd*dd  ,phi  aa  .ph  i  bb  1 
snphi i-dsin(phibb-phiaa) 


22/ 
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ei  svs  f i nal / 1 2  for/ j ten  forM 
subroutine  JTENltenjl 

************************************************************************ 

implicit  double  precision  (a-zl 

double  precision  tenj 

i nt  eaer*2  i  leg  ,  t  s  t  ,nca  ,ncb  ,nwa  ,n»b  ,  i  so  1  ,  i  bench  ,uz  (5  ) 
double  precision  z  (67  1  ,cz  >cx  ,d  ,  ta  ,  t  b 

common  /VGLOB/  i  leg  , i s f  .nca  ,ncb  ,z  ,cz  .cx  ,d  ,ta  ,tb  ,n»o  ,n»b  , 

A  i  so  1  .  i  brnch  ,uz 
double  precision  za(2S I  iZb(25  ) 
equivalence  lz( I  I  ,zal 1  II  ,(z(26  I  ,zb( I  I  I 

double  precision  ha  ,a I  a  ,va  ,s I  a  ,*  1  a  ,c  1  a  ,s2a  ,w2a  ,c2a  ,s3a  ,»3a  , 

A  xa  iva  .xla  ,x2a  ,x3a  ,yla  ,v2a  ,y3a  , 

A  t  ana2a  ,  t  ana3a  ,  t  anala  ,  t  ana5a  .  t ana6a  ,1a  ,ph i a 
equivalence  (za  (  I  I  ,ha  1  ■  ( za  (2  I  ,a1  a  ,va  1  ■ 

A  (  za  (  3  I  ,s  I  a  I  ,  ( za  M  I  ,w  I  a  I  ,  ( za  ( 5  I  ,c  I  a  1  , 

A  (  za  (6  I  ,s2o  I  ,  (  za  (  7  l  ,« 2a  I  ,  ( za  (8  I  ,c2a  I  , 

A  ( za  19  )  ,s3a )  ,  I  za  11 0  I  ,w3a  I  ,  (za  (  I  I  I  ,xa  1  , 1  za  (  t  2  )  ,ya  )  , 

A  ( za  (13)  ,xlai  ,  ( za  ( 1 4  I  ,x2ol  ,(za(l5l  ,x3a)  , 

A  (  za(  16  I  ,y  I  a  I  ,  ( zal  I  7  1  ,y2o  I  ,  (  za(  1 8  I  ,y3a  )  , 

A  (za(l9l  ,tana2al  ,(za(20l  ,fana3al  ,(za(2l  I  .tona'ta)  , 

A  ( za ( 22  I  , l anaSa I  , ( za ( 23  I  ,  t ana6a  I  ,  ( za 1 2*  )  ,1a)  ,  ( za ( 25  I  ,ph i a  I 
double  precision  hb  ,alb  ,vb  ,s1b  ,wlb  ,c!b  ,s?b  ,»?b  ,c2b  ,s3b  ,w3b  , 

A  xb  ,yb  ,xlb  ,x2b  ,x3b  ,y!b  ,y2b  ,y3b  , 

A  t  ana2b  ,  t ana3b  ,  t  ana*b  ,  t  anaSb  ,  i ana6b  ,  1 b  ,ph i b 
equ  i  valence  (zbll  I  ,hb)  >  ( zb  ( 2  I  ,a  1  b  ,vb  )  , 

A  ( zb  (  3  I  .sib)  ,(zbM  I  ,wlbl  ,(zb(5l  .clb)  , 

A  (zb(6l  ,s2b  I  ,  ( zb  (  7  1  ,*2b  1  ,  ( zb  ( 8  )  ,c2b  1  , 

A  (  zb(9  l  ,s3b  I  ,  (zb(  10  l  ,w3b  l  ,  (zb  I  l  u  ,xb  l  ,(zb(  I  2  i  ,vb  )  , 

(zb(  1  3  l  ,xlb  l  ,(zb(  H  I  ,x2b  )  ,(zb(  15  I  ,x3b  1  , 

A  ( zb(  16  )  ,y  lb  I  ,  (zb  ( I  7  I  ,y2b  I  ,  (  zb  (  I  8  I  ,y3b  )  , 

A  t  zb  119)  ,iano2b)  ,  I  zb (20)  ,tana3b)  » ( z b 1 2 1  )  ,  tanolb)  , 

A  ( zb (22  l  ,  t anaSb I  ,  ( zb (23  1  ,i ana6b  )  ,  ( zb (24  )  ,1b)  ,lzb(2S)  ,phi b ) 

double  precision  coil  ,s  Ip  ,  fre  t  ,c3  ,s1  ,x4  ,y4  ,  t  ana7  ,  t  ana8  , 1  , 

A  h.phih.rtot  ,xtot  ,zloi  ,do 

equ i valence  ( z (5 1  )  ,co il  I  ,(z(52)  ,slp) ,lz(53)  , fre t  )  ,  I z ( 5*  )  ,c3)  , 

A  lz(55  )  ,s-»>  ,lz(56  I  ,«*1  )  ,(z  (57  )  ,x*  I  ,(z  158  )  ,y*  )  , 

A  ( z ( 59  I  ,  t  ana  7  )  ,  ( z ( 60  )  ,  t  ana8  )  ,  ( z ( 6 1  )  ,1  I  , 

A  lz(62l  ,h)  ,(z(63)  ,phihl  , 

A  ( z (6i  )  ,riot  I  ,  ( z  (65  )  ,x  t o t  I  ,  ( z  (66  I  ,z  t  o t  )  ,  I  z  ( 67  )  ,do  ) 
double  precision  b  ,smb  ,cosb  ,tanb  ,secb 
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equivalence  <  z 1 2S  J  ,b  I  ,(z<26)  ,sinb!  ,(z!27)  ,cosb  )  ,iz(28)  ,ianbl  , 

A  (z  (29  )  .secb  I 

inieger*2  uz 1  >uz2  >uz3  (uz^  >uzb  _  ...  A. 

equivalence  (uz(1  I  .uzl  )  .(uz(2l  .uz2  I  ,(uzt3l  ,uz3  )  ,(uzHI  .uz-d  , 

A  (uz (S  1  .uzS  ) 

double  precision  snphih  .csphih  ,snafh  ,csafh  .tnafh  ,scafh 
pnrmnn  /VHD1R/  snoh i h  ,csph i h  ,sna f h  ,csa fh  ,  l no f h  ,sca f h 

t$t$*****tt**t*******t****tttt*t**t**t**t*tttttttt*******tift**tt*******> 

ien  j-h*SECNT ( tana  7 l*dcos (daian ( tana7 1-datan I tnafh ) I 
A  - (c3+ I *k*  )*snafh 
ret  urn 
end 
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et  sys  f  mal/t2for/junct  forJt 

subroutine  JUNCT ( tna  i  mb  ,  index ) 

************************************************************************ 

implicit  double  precision  la-zl 

integer*2  index 

double  precision  tna, mb 

integer*2  ileg,ist  ,nca  ,  neb  ,n*a  ,n*b  ,  i  sol  .ibrnch  ,uz  IS  I 
double  precision  z  (67  I  ,cz  ,cx  ,d  , ta  , t b 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  ,ta  ,tb  ,nwo  ,n«*b  , 

4  isol  ,ibrnch  ,uz 
double  precision  za (2S  I  ,zb ( 2S ) 
equivalence  (z  (  I  1  ,za  (1  II  ,  ( z  126  I  ,zb  ( 1  I  I 

double  precision  ho  ,al  a  ,va  ,s  1  a  ,*  I  a  ,c  I  a  ,s2a  ,«2a  ,c2a  ,s3a  ,»3a  , 

4  xa  ,ya  ,xla  ,x2a  ,x3o  ,y1a  ,y2a  ,y3a  , 

4  t  ona2a  ,  t  ono3a  ,  i anaia  ,  t  ona5a  ,  t  ana6a  ,  1  a  ,ph i a 
equivalence  (zo( I  I  ,ha  I  ,(za(2  I  ,ala  ,vo)  , 

4  (za<  3  )  ,s  I  a  I  ,  (zaM  I  ,w1a  I  ,  I  za  (S  I  ,cl  a  I  , 

4  ( za  (6  I  ,s2a  I  ,  (za  l  7  )  ,w2a  I  ,  (za  (8  )  ,c2o  I  , 

4  ( za  (9  I  ,s3a  I  ,  (za  1 1 0  I  ,w3a  I  ,  ( za  (  I  I  I  ,xa  I  ,  I  za  M  2  I  ,ya  l  , 

4  ( za  ( I  3  I  ,x  I  a  I  ,  ( za<  M  I  ,x2a  i  ,  ( za  (151  ,x3o  )  , 

4  ( za (16  1  ,ylal  ,(zoll7)  ,y2a  I  ,  ( za ( 1 8  I  ,y3o  I  , 

4  ( za ( 1 9  )  ,  t ona2a  I  ,  ( za ( 20  I  ,  t ana3a  I  ,  i za 1 2 1  I  ,  t  ana4o  I  , 

4  ( za  ( 22  I  ,  t  anaSo  I  ,  ( za  ( 23  I  ,  t  ano6o  I  ,  t  za ( 24  I  ,lal  ,  i  za  1 2S  I  .ph  i  o  i 

double  precision  hb  ,olb  ,vb  ,slb  ,*lb  ,clb  ,s2b  ,w2b  ,c2b  ,s3b  ,*3b  . 

4  xb  ,yb  ,x  I  b  ,x2b  ,x3b  ,y  1  b  ,y2b  ,y3b  , 

4  t  ana2b  ,  t  ana3b  ■  t  ono4b  ,  t  ana5b  ,  t ana6b  ,  1 b  ,ph i b 
equivalence  ( zb  (  I  I  ,hb  I  ,  ( zb  (2  I  ,ol  b  ,vb  I  , 

4  ( zb  ( 3  I  ,s  I  b  I  ,  ( zb  M  l  ,» 1  b  I  ,  ( zb  I S  I  ,c  1  b  I  , 

4  ( zb  ( 6  I  ,s2b  )  ,  ( zb  (  7  l  ,w2b  I  ,  ( zb  ( 8  I  ,c2b  I  , 

4  (zb (9  I  >s3b  I  , (zb 1 10  I  ,»3b  I  , <  zb ( I  I  I  ,xb  I  ,  l zb(  I  2  )  ,yb  )  , 

4  (zb(  I  3  I  ,xlb  I  ,  ( zb  (  M  I  ,x2b  I  ,(zb(  15  I  ,x3b  I  , 

4  ( zb  (16  1  ,y  I  b  I  ,  ( zb  (  I  7  I  ,y2b  I  ,  (  zb  II 8  I  ,y  3b  I  , 

4  ( zb ( 1 9  I  ,  tana2b  I  ,( zb  1 20  I  ,  t ana3b 1  , 1  zb  1 2 1  I  ,  t ona4b  I  , 

4  ( zb (22  I  1 1 anoSb  I  ,  I  zb  1 23  I  ,  t  ana6b  I  ,  I  zb  1 2*  )  ,  1 b  )  ,( zb  1 25  I  ,ph i b I 

double  precision  coi  I  ,slp  ,frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,tona7  ,tano8  ,1  , 

4  h.phih.rtot  ,xtot  ,ztot  ,do 

equivalence  (z IS  I  I  ,coi 1  I  ,  I z (52  I  ,s Ip  I  ,  I z 153  )  ,  fre  t  I  ,  (z 154  I  ,c3  I  , 

4  (z  (55  I  ,s4  I  ,  ( z  ( 56  I  ,w4  I  ,  (  z  1 57  1  ,x4  I  ,(z  (58  I  ,y4  I  , 

4  ( z ( 59  I  >  t  ana7  I  ,  ( z ( 60  I  ,  t  ana8  I  ,  I z 1 6 1  I  ,  1  I  , 

4  ( z  (62  I  ,h)  ,  ( z  (63  I  .phihl  , 

4  ( z (64  I  ,rtot  I  ,  (z  165  1  ,xtot  I  ,(z(66l  ,ztot  I  ,(zl67l  ,do  I 


\Z1 


I 


double  precision  pi  .halfpi  , degrad  ,raddeg  .zero  ,  one  ,  ha  I f 
mieger*2  izero  .lone  >1  two 

common  /VCONST/  pi  ,hal tpi  , degrad  ,raddeg  .zero  ,one  >hal f  , 

4  i zero  .tone  , t  too 

i nieaer*2  i scopa  ,  i scopb  ,  i t  ana  .  i t  anb  ,  i e 
double  precision  epsy.gamma.se 

common  /VCMPD/  epsy  .gamma  ,se  , i scopa  .  i scopb  ,  i t ana  , i i anb  ,  i e 

doub 1 e  precision  a  ,b  ,snph i  ,  t  na ( a  ,  t  na ( b  , 

4  seca7  ,seca8  ,ut  ,si  ,yk  t  ,zk  i  ,eex  ,eez  >eey  .ybuoy 
common  /VCSSHP/  a.b.snphi  .inafa  .tnafb  , 

4  seca?  ,seca8  ,uf  .st  .yk  i  .zk  r  ,eex  .eez  .eey  .ybuoy 

equivalence  (csphi  .gamma  I  .(sea  >eex  )  .  (seb  .eez  ) 

tt*************t****tt**tf**t*t***t**ttt***tt**t**t***t***t***tttt*****t 

sca-SECNT ( ina 1 
scb-SECNT ( mb ) 

csphi-dsqrt (one-snphi*snphi ) 
if  (phib-phia  gi  halfpi)  csphi-  -csphi 
gomma-pi -dacosl I ina* mb*csph i  l/lsca*scb  )  ) 
if  (index  ne  tone)  goto  100 
ia-ha*sca 
ib-hb*scb 
100  coni  mue 
re  turn 
end 


ei  svs  f mol / t 2for/ebuoy  for## 

********S5S**i«***#***«*********************»****»****************M*** 

*  Assiqns  values  to  parameters  ut  ,s i  ,yk i  ,zk '  for  branch  assumed  to  be 

*  under  tension  Assumes  junction  to  be  just  of  ocean  door 

*  Computes  junction  v -coord  ,  vertical  riser  displacement  .  buoy  y 


coord 


*  ibrnch  -  index  of  tension  branch  1  for  A,  2  for  B 

*  ut  -  unit  factor  for  tension  branch  1  for  A,  -I  tor  H 

*  st  -  length  of  tension  branch 

*  halhb  -  Toad  on  tension  branch 

*  ykt  -  y-coord  of  tension  branch  anchor 

*  zkt  -  2 -coord  of  tension  branch  anchor 

*  eey  *  y-coord  of  junction,  in  general  ,  of  point  on  floor 

*  directly  beneath  junction 

************************************************************************ 

implicit  double  precision  (a-2) 


integer*?  i  leg  ,ist  ,nca  >ncb  ,n«a  ,nwb  ,iSol  .ibrnch  ,uzl5  ) 
double  precision  z (67  I  ,c2  ,cx  ,d > t a  ,  tb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  ,d  >'a  ,tb  ,n*o  ,nwb  , 

4  i sol  .ibrnch  ,uz 
double  precision  zo(251  ,zb(25( 
equ i va  1  ence  (z(M,za(lil,lz(26).zb(l)) 

double  precision  ha  ,ol  a  ,vo  ,sl  a  ,w!a  ,c  I  a  ,s2a  ,w2a  >c2a  ,ssa  ,*so  , 
4  xa  ,yo  ,x  1  a  ,x2o  ,x3a  ,y  1  a  ,y2a  ,y 3a  , 

4  t  ono2o  ,  t  ana3a  ,  t onolo  ,  t ano5a  ,  t anaba  > 1  a  >ph i a 
equ  i  valence  I  zo  ( 1  )  ,ha  l,(zal2)>ala,val, 

4  ( za(  3  1  ,sl  a  1  ,  ( zo  M  I  ,w1  a  I  ,  I  za  15  )  ,c  I  a  I  > 

4  izalb  I  ,s2o  1  ,( za  1 7  1  ,w2a  )>(  za  (8  )  ,c2a  1  , 

4  (zo(9  1  ,s3al  ,(za(  10)  ,»3a)  ,(za(l  I  )  ,xoi  ,lzaH2)  ,ya)  , 

4  (za(  1 3 1  ,xla  1  .izallll  ,x2a  l  ,<zo(  151  ,x3a  )  , 

4  lzo(l6)  , vial  ,(za(17(  ,y2ai  ,(zoil8l  ,y3ol  , 

4  120(19)  ,tono2al  ,(za(20l  ,tana3al  ,(zo(2M  .tanalal  , 

4  ( za 1 22  )  .tonaSo)  ,(za(23)  ,tona6a)  ,(zo(2A)  ,1a)  ■ 1 Z«'2S ' ’phi® ' 

double  precision  hb  »o1b  >vb  »slb  ,*1b  .clb  »s2b  >*2b  >c2b  >s5b  > 
4  xb  ,yb  ,x1b  ,x2b  ,x3b  ,y  1b  ,y2b  ,y3b  , 

4  t  ona2b  ,  f  ono3b  ,  t  ano#b  ,  t  ano5b  ,  t ana 6b , 1 b  ,ph i b 
equ  i  vo  1  ence  ( zb  1 1  1  ,hb  1  ,  ( zb  1 2  I  ,o  1  b  ,vb  )  . 

4  ( zb ( 3  1  ,s1b  1  ,  ( zb  H  1  ,«1b)  ,(zb(5l  ,c1bl  , 

4  (2b(6I  ,s2bl  ,(zb(7l  ,t»2b)  ,(zb(8)  ,c2b)  , 

4  (zb(9)  ,s3b  I  ,(zb(10l  ,w3b)  ,(zb(11  1  ,xb  1  ,lzb(l2)  ,yb)  , 


4  (zb(  t  3  )  ,x)b )  ,<zbl  1 1 1  ,x2b  I  ,(zb(l5l  ,x3bl  , 

4  (zb(  16  I  ,y  lb  >  ,  (zb(  1 7  I  ,y2b  I  ,  ( zb ( 1  8  I  ,y3b  )  , 

4  (zb (19)  ,tana2b)  ,(zb(20l  ,tana3bl  ,(zb(2l  1  .lanalbl  , 

4  (zb (22)  1 1 anaSb )  ,(zb(23)  ,tana6b)  .(zb  1 21  )  ,1b)  ,  I  zb (25)  .phibl 
double  precision  coi  1  ,slp  ,frci  .c3  ,s1  ,w1  ,x1  ,y1  ,iana7  ,  tana8  >)  , 

4  h.phih.rioi  ,xioi  ,zioi  ,do 

equ i valence  (z(Sl  )  .coil  1  .  ( z ( 52  )  ,sipl  » ( z ( 53 )  ►  fee  f  )  .  ( z (51 )  .c3) » 

4  ( z  (55  1  .si  1  ,  (z  (56  )  ,w1  )  ,  ( z  (57  I  .xl )  ,  ( z  ( 58  )  ,yl  )  , 

4  (z  (59  I  , i ana 7  )  ,(z(60  I  ,iana8  )  ,(z  (61  I  ,1  I  , 

4  (z (62  )  .hi  .  (z (63 1  ,phih I  . 

4  (z  (61  I  ,r lol  )  ,(z  (65  )  .xioi  I  ,  (z  (66  I  ,zlot  I  ,(z  (67  )  ,do  ) 

double  precision  pi  .halfpi  ,degr ad  .raddeg  ,zer o  .one  ,ha  I  f 
integer *2  i zero  , lone  , i i wo 

common  /VCONST/  pi  , halfpi  .degrad  .raddeg  .zero  .one , ha  1 f , 

4  i zero  ,ione  . i two 

double  precision  de I y k  , twod  ,ha 1 fd  ,dsq 
common  /VANCH/  de 1 v k  .  l wod  ,ha I f d  ,dsq 

double  precision  sa  ,sb  ,ca  ,cb  ,vc0a (6  I  ,vc0b  16  )  , 

4  eex0  >eez0  ,eey0  ,a0  ,b0  ,ph  i  a0  ,ph  i  b0 
inieger*2  icase 

common  /VSPID/  sa  ,sb  ,ca  .cb  ,vc0a  ,vc0b  , 

4  eex0  >eez0  ,eey0  .a0  .b0  ,phia0  ,phtb0  , 

4  i  case 

double  precision  snphi h  .csphih .snafh  .csafh , i na f h ,sca fh 
common  /VHQ1R/  snph  ih  ,csph  ih  ,sna  fh  ,csa  f  h  ,  i  na  fh  .scafh 

double  precision  hinafh  >h*1  .wlh  .slwlh  ,c3h 
common  /VHVEC/  hinafh  .hwl  , wlh  , slwlh  ,c3h 

i n i eg er *2  i scopa  .  i scopb  > i ) ana  > i ( anb  ,  i e 
double  precision  epsy  .gamma  ,se 

common  / VCMPO /  epsy  .gamma  ,se  ,  i scopa  ,  i scopb  ,  i ' ana  ,  i t  anb  ,  i e 
integer*2  i tarn 

double  precision  a.  b  .snphi  ,  inafa  .inafb  , 

4  seca7  ,seca8  ,ui  ,si  .yk  t  ,zk »  .eex  .eez  ,eey  .ybuoy 
common  /VCSSHP7  a  .b  .snphi  .inafa  .inafb  , 

4  seca7  ,seca8  .ui  .si  .yk  i  ,zk  »  .eex  ,eez  .eey  .ybuoy  >i  lam 

*mm*mi*mmm«um»*m****»******«***<*m»******«*«»**«»i 
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I  SI 


if  (ibrnch  ne  II  goto  20 
u i -one 
st -so 
ho-h 

i t  on  t - 1 1 ono 
goto  S0 
20  coni inue 
ut-  -one 
st-sb 
hb-h 

i t  on  t - 1 t  onb 
50  cont inue 

2k l-ut*hol fd 

yk  t-CZ*2k I 

eey-vk  t+st*snofh 

tono7-tnofh+c3h 

coll  TRISR 

ybuoy-eey*y1 

return 

end 
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ei  sys  f mol/t2for/scoi 1  forll 

subrout  me  SCOIL  (net  ,zt  ,vc0i  .ct  ,n«t  ,ncc  ,zc  ,wc0c  ,sc  ,n err  ) 

***** ******************************************************************* 
implicit  integer*2  (“1 
implicit  double  precision  (a-z) 

integer *2  net  ,n»t  ,ncc  ,nerr 

double  precision  z t  (25  I  >vc0t  (6  I  tc  t  iZC  <25  )  >vc0c  1 6 )  ,sc 

i  nteger  *2  i  leg  ,  i  s  t  ,nca  ,ncb  ,n«»a  ,nwb  ,  i  so  I  ,  ibrnch  ,uz  1 5  ) 
double  precision  z (67  I  ,cz  ,cx  ,d  , t a  i tb 

common  /VGLOB/  i  leg  , i s t  ,nca  ineb  ,z  ,cz  ,cx  ,d  . t a  , t b  ,n*ra  ,n«b  , 

4  i sol  , i brnch  ,uZ 
double  precision  za (25  I  ,zb (25  I 
equ  i  va  1  ence  ( z  (  I  I  ,za  (  1  I  I  ,  ( z  ( 26  I  ,zb  ( 1  1  ) 

double  precision  ha  ,ala  .va  ,sla  .«*1a  .cla  ,s2a  ,»2a  ,c2a  >s3a  ,»3 a  , 

4  xa  ,ya  ,xta  .x2a  ,x3a  ,yla  .y2a  ,y3a  , 

4  t  ana2a  ,  t  ana3a , t  anaia  .  t  anaSa  .  t  ana6o  ,1a  ,ph i a 
equivalence  (za( I  )  ,ha  1  , ( za(2  I  .at a  ,va I  , 

4  <za<  3  1  .si  a  1  ,  <za(  4  1  ,w  I  a  I  ,  ( za  IS  I  ,c  1  a  I  , 

4  (za(6)  ,s2a  I  ,(za(7)  ,i«2a  1  >(za(81  ,c2a)  , 

4  ( za(9  I  ,s3a  1  ,  (za(  10  I  >w3a  I  ,  (za  ( I  1  I  ,xa  I  ,  ( za  f ) 2  )  ,ya  )  , 

4  I  za  ( 1  3  I  >x  I  a  )  ilzal  M  I  ,x2a>  ,(za(  15  )  ,x3a  )  , 

4  ( za  (16)  ,ylal  ,  ( za  (  1  7  I  ,y2a  )  ■  ( za  I  1 8  I  ,v3al  , 

4  l za( 1 9  )  ,  tana2a  1  ,  ( za  <20  1  ,  tana3a I  ,  ( zo ( 2 1  )  ,  t anala  )  , 

4  ( za ( 22  )  ,  t  ana5a  I  .  ( za (23  I  ,  t ana6o  I  ■  ( za ( 24  )  ,  1  a  I  ,  I za I  25  l  ,ph i a  I 

double  precision  hb  ,alb  ,vb  ,s(b  ,wlb  ,clb  ,s2b  ,w2b  ,c2b  ,s3b  ,»3b  , 

4  xb  ,yb  ,x  I  b  >x2b  .x3b  .y  I  b  .y2b  ,y3b  . 

4  t  ana2b  ,  t  ana3b  ,  t  ana4b  ,  t  ana5b  ,  t  ana6b  ,  1 b  ,ph i b 
equ  i  va  1  ence  ( zb  I  I  1  ,hb  I  ■  ( zb  ( 2  I  .alb.vbl  , 

4  l  zb  ( 3  I  ,s  1  b  l  ,  ( zb  ( 4  1  ,« 1  b  )  .  ( zb  ( 5  I  ,c  I  b  I  , 

4  (zb  (6  1  ,s2b  1  i  (zb  (  7  1  ,*2b  )  ,  !zb  (8  I  ,c2b  )  , 

4  (zb (9)  ,s3b  1  ,(zb(  10  I  ,w3b  )  , ( zb ( 1  1  I  ,xb  )  ,(zb(  12  I  ,vb  )  , 

4  ( zb  ( I  3  I  ,x  1  b  )  ,  ( zb  ( 1 4  I  ,x2b  I  .  (  zb  (151  ,x3b  )  , 

4  ( zb  (  1 6  I  ,y  1  b  1  ,  ( zb  ( 1  7  I  ,y2b  I  .  (  zb  (181  ,y3b  I  , 

4  ( zb ( I  9  1  ,  t  ana2b  1  ,  (zb (20 )  ,  l ana3b  I  ,  ( zb 1 2 1  I  .  t ana4b  )  > 

4  (zb (22  I  .tanaSb  )  ,  (zb  123  1  ,tana6b  I  ,  ( zb (24  )  ,  lb  I  .  I  zb  125  1  ,phib  ) 

double  precision  coi  l  ,slp  ,frct  .c3  ,s4  ,«4  ,x4  ,y4  ,tana7  , tana8  ,1  , 

4  h  ,ph  ih.rtot  .xlot  .Ztot  ,dO 

equivalence  ( ■»  '  5 1  I  >co  il  t  >  ( z  ( 52  I  .sip)  ,  ( z  (S3  )  ,  f  rc  t  )  ,  (z  (54  I  ,c3)  . 

4  (z(55  )  ,s4  I  ,.z(56  I  ,»4  I  ,(z(57  !  ,x4  I  ,(z  158  I  ,y4  )  . 

4  ( z  (59  )  ,tana7  I  ,  (z  (60  I  >tana8  I  .  (z  (61  )  .1  )  , 

4  I  z  ( 62  )  ,h>  ,(z(63>  ,phih)  , 


Cxi 

ro 


t 


/  33 


4  (2(61 )  ,rio»  1  ,(z(65)  ,xfoi I  ,(z(66l  .2tot )  ,(z<67) ,do» 

double  precision  pi  .halfpi  , degrad  .raddeg  .zero  ,one ,hal f 
integer*?  tzero  .tone >i two 

common  /VCONST/  pi  ,hal fpi  .degrad  , raddeg  .zero  ,one  ,hal f , 

4  i zero  ,  i one  .  1 1 wo 

i n i eger  *2  i scopa  ,  i scopb  ,  i 1  ana  ,  i i anb  ,  i e 
double  precision  epsy.gamma.se 

common  / VCMPO/  epsy  .gamma  ,se  ,  i scopa  .  i scopb  ,  i i ana  ,  i i anb  ,  i e 

double  precision  snph i h  ,csph i h  .snafh  ,csa fh  , tna fh  ,sca fh 
common  /VHDIR/  snphih  .csphih  .snafh  .csafh  .tnafh  .scafh 

double  precision  htnafh.hwl  , wlh  .slwlh  ,c3h 
common  /VHVEC/  h I na fh  .hwl  , wlh  , slwlh  ,c3h 

inieaer*2  Ham 

double  precision  a  ,b  .snphi  .tnafa  ,mafb  , 

4  seca7  >seca8  ,ui  ,s  t  .yk  i  ,2k  i  ,eex  ,eez  .eey  .ybuov 
common  /VCSSHP/  a. b  .snphi  ,  i na f a  .  i na fb  , 

4  seca7  ,seca8  ,u  t  ,s  t  ,y  k  i  ,zk  t  ,eex  ,eez  .eey  .ybuoy  ,  i  i  am 

inieqer*2  i vs 

double  precision  v0  ,vl  ,v2  , f 0  ,  f  l  ,f 2  ,f  ,eps 
common  /V  SEC/  v0  ,vl  ,v2  ,f0  ,fl  .  f  2  ,  f  ,eps  ,ivs 

integer *2  i Ih0  , t lh !  , i 1 h2  , i 1 

double  precision  IhB.lhl  ,lh2,ce 

common  /VSC01L/  lh0  ,lh!  ,lh2  ,ce  ,i  lh0  ,i  Ihl  . ,  |  h2  ,i  1 

i n i eger *2  ilh(3l 

double  precision  lh(3i 

equivalence  ( i lh  ,i lh0)  ,( lh  ,|h0  I 


amma  1 

**************************** 


I  vs-0 

call  XSECV  tnc  t  >zt  >vc0t  ,s  i  ,ci  .nwi  ,ncc  .zc  ,vc0c  . 
4  snafh  .csafh  .inafh  .scafh  ,1  ,nerr  ) 
if  (nerr  ne  01  goto  S000 


equivalence  (kte.coill.lkcesq.t  anaj  .< 
*********************** ************«****i*; 

*  wriie(10,*l  'SCO  It  '  .ibrnch  .ybuoy 
f-do 


W 

U) 


2000  con r i nue 

call  X4CALC 
v le-zt (II) 
eex-k te*csphih 
eez-zk  t  *k ie*snphih 
kcesq«eex*eex* ( zk i +eez 1**2 

coil -sc-dsqr l ( kcesq* (y k i *y k  t ♦ k  te*  cna fh  1**2  I - lh2 
tanaj-zt ( 1 1 an  I  I 
ta-h*SECNT ( lanaj I 
ib-ce 

if  (ibrnch  eq  II  goio  2110 

ib- 1  a 

la-ce 

2110  coni inue 

gamma-da i an ( l ana j I +ha 1 f  p i 


5000  con  t i nue 
return 


ei  svs  f inel/i2for/xsecv  forll 

subrout  me  XSECVIncf  a  t  .vc0t  .sip  ,d  -ncc  ,zc  ,vc0c  , 

implicit  integer *2  <“> 
implicit  double  precision  (a-z) 

mteger*2  net  ,nwt  .ncc  .1  f  typ  ,nerr  f 

double  precision  zt (25)  ,vc0t (6!  ,stp  ,ci  ,zc(25)  ,vc0c(6)  , 

4  sinof  .cos af  ,  t onaf  .secaf 

integer*2  i  leg  .ist  .nca  .neb  .n«a  .nmb  .isol  .ibrnch  ,uz(5) 
double  precision  z (67 )  ,cz  ,cx .d , t a , tb 

common  /VCLOB/  i  leg  .ist  ,nca  ,ncb  ,z  .cz  ,cx  ,d  .ta  ,tb  ,n*a  ,n*b  . 

4  i sol  .ibrnch  ,uz 
double  precision  za (25  1  , zb  12b  l 
equivalence  (z( 1  1  .za( 1  I  I  ,  ( z ( 26  I  .zb ( 1  I  ) 

double  precision  ha  >a  la  .  va  .s  I  a  .» la  .c  la  .s2a  .*2a  ,c2a  ,s3a  ,w  a. 

4  xa  ,va  .x  1  a  >x2a  ,x3a  .v  I  a  >v2a  .v3a  . 

4  t  ana2a  .  t  ana3a  .  t  ana3a  ,  t  ana5a  ,  t  anaoa  ,  1  a  ,ph i a 
equivalence  <za( I  )  ,ha  I  ,(za(2)  .a'a.ya)  , 

4  I  za( 3  I  .si a  I  ,(za(3  )  ,»ia)  ,(za(5i  .da)  , 

4  (za(6)  ,s2al  ,(za(7i  ,«2al  ,(za(8)  .c2al  . 

4  (za(9)  ,s3a  )  ,lzal)0)  ,»3ai  ,(za(  I  l  >  .xa  )  ,  (za  1 1 2  >  .va  )  . 

4  (za(  I  3  )  >x  1  a  )  ,(za(Hl  ,x2a  I  ,(zaM5  I  .x3a  )  , 

4  (za ( 16  )  .y  l o  I  ,  (za(  1  7  1  ,y2a  I  , (za<  18 1  ,v3a  )  , 

4  (zoU9)  >tana2al  ,lzo(20i  ,tana3a)  ,lza(2n  .tana3ai. 

4  (zal22  )  .  tana5a  )  ,(za(23l  ,tana6al  ,  ( z<a  1 •  .la)  .  (za(25)  .P^ia 
double  precision  hb  ,alb  >vb  .sib  .wlb  ,clb  .s2b  .*>2b  .c2b  ,s3b  ,w5b  . 

4  xb  .yb  ,x)b  ,x2b  ,x3b  ,vlb  .y2b  ,v3b  . 

&  t  ono2b » t  ana  3  b  » i ano^b  ,  • anaSb  ,  I onaob  > 1 b  >pn » b 
equi  valence  ( zb  ( I)  .hb  )  ,  ( zb  ( 2  )  ,ol  b  ,vb  )  , 

4  ( zb ( 3  )  .sib  I  .(zb (3  I  ,wlb)  ,(zbl5)  ,dbl  , 

4  Izb  (6  )  ,s2b )  .  ( zb  ( 7  I  ,*2b  i  .(zb(8 1  .c2b  I  .  .. 

4  (zb  19)  ,s3b)  ,  ( zb  (  10  >  >w3b)  ,  ( zb  (111  >*b  )  .  I  zb  112)  .  vb  I  . 

4  ( zb  ( 1  3  )  .x  lb  I  .  I  zb  ( 1 3  I  ,x2b  )  .  (  zb  ( !  5  I  .x3b  !  . 

4  (zb<l6)  .ylbl  ,(zb(l7)  ,y2b)  ,tzbl)8)  .v3b)  . 

4  (zbM9)  .tooa2bl  .(zb(20)  ,tana3bi  ,lzbl2»  )  .  ana3b)  . 

4  ( zb  122  )  .tanaSbl  ,  l  zb  (33  1  ,tano6bl  ,(zb(23  I  ,ib)  >  *  f 5  1 ’{£ib  / 

double  precision  coi  1  .sip  .fret  ,c3  ,s3  .*3  ,x3  ,v3  ,  t  ana7  , t ano8  ,1  , 

4  h  ,phih  ,rtot  .xtot  .Ztot  .do  ,  ,  .r.,  j, 

equivalence  ( z  (S  t  I  ,coi  I  I  ,(z(52  I  .sip  >  .<*(53  )  .fret  I  .(z(53  )  ,c3)  , 
4  (z  <55  I  >s3  I  ,  ( z  (56  I  ,«3  I  .  (z  (57  I  ,x3  )  ,  ( z  (58  1  .v3  )  . 


A  (z(S9)  ,  tana7)  ,  (z(60)  ,  tana8)  >(2(61 )  ,1 )  , 

A  ( z  (62  )  ih  )  ,(z(63)  ,ph  i  h  !  , 

A  ( z <64  I  ,r  lot  )  i ! z  (65  )  ,x  to  i  )  ,(2(66)  ,2 lot  )  ,(2(67)  ,do  ) 

double  precision  pi  ,hal fpi  >degrad  .raddeg  .zero  , one  ,hal  f 
mteger*2  1  zero  ,  1  one  ,  1  two 

common  /VCONST/  pi  ,hal fpi  , degrad  .raddeg  .zero  ,one  ,hal f  , 

A  1  zero  ,  1  one  ,  1 1 *0 

double  precision  snph ih  ,csph 1 h  ,snafh  ,csafh  ,  1 na f h  ,scaf h 
common  / VHDIR /  snph i h  ,csph  1  h  ,sna fh  ,csa fh  ,  1  na f h  ,sca f h 

double  precision  hmafh  ,h*»4  ,»4h  ,s4w4h  ,c3h 
common  /VHVEC/  hmafh  ,h\*1  ,*4h  ,s4w1h  ,c?h 

integer *2  1  lam 

double  precision  a  ,b  ,snphi  ,  1  na  f  a  ,  ma  ft>  , 

A  seca7  ,seca8  ,ur  ,si  ,yk  1  ,2k  r  ,eex  ,eez  ,eev  ,ybuov 
common  /VCSSHP/  a.b.snphi  ,  I na f a  ,  1 na f b  , 

A  seca7  ,seca8  ,ut  ,si  ,yk  1  ,zk  1  ,ee«  ,eez  ,eev  ,vbuov  ,1  iani 

inieger*2  ivs 

double  precision  v0  ,vl  ,v2  ,  f0  ,f !  ,f2  ,f  ,eps 
common  /VSEC/  v0  ,v  1  ,v2  , f0  , f  I  .(2  ,<  ,eps  ,  1  vs 
double  precision  varray ( 3  I  ,  f array  I  3 ) 
equ 1 va I ence  <  v0  ,  varray  )  ,(f0,farrayl 

double  precision  fred 

miegert2  isidf  .nerra  ,nerrb 

common  /VSTAB/  fred  ,  1 S 1 d f  .nerra  ,nerrb 

mteger*2  1 lh0 , 1 1 h I  , i I h2 . 1 1 
double  precision  lh0,lhl  ,lh2,ce 

common  /VSCOIL/  I  h0 , 1  h  1  , 1  h2  ,ce  ,  1  1  h0  , 1  1  h  I  ,1  lh2 ,1  1 

integer *2  1 Ih ( 3  ) 

double  precision  lh<3l 

equ 1 va 1 ence  ( 1 1 h  ,  1 1 h0  I  ,  ( I h  ,  1 h0  1 

integer*2  nerr  ,m  t  ,1  ,j  ,n  ,ivint  ,ndiv  ,is  .in 

equ 1  valence  Ih t  ,  t a  I  ,  ( h t ana f  ,  1 b I  ,  (h  tenth  .gamma )  ,  I dv  ,eex 1  , 

A  (vbase  ,eez  I  ,(  fbase  ,eey  I  ,(absfb  ,rtot  )  ,(Tl  im  ,xtot  )  ,1  len  ,ztot  )  , 
A  (ctht  ,coi  1  ) 


I  r>  / 


equ i valence  ( 1 en  ,de I v  ,v0sav I  , (c I h i  ,de 1 v0  >v 1 o»  ,v I sav I  , 

4  (del vl  ,vhigh  ,f0sav  1  ,lrai  ,hlerm  ,  f 1 sav  )  ,( rat max  ,rat0)  , 

&  ( is  ,in tivint  I 

************************************************************************ 

nerr  f - 1 
hi -Zl  M  ) 

*  write  (10,*)  'XSECV'  ,  f  ,ht  ,  iftyp 
htanaf-ht*tanaf 

smal 1  *  I  0d- 1 0 
eps- f*smal I 

if  (ivs  eq  0 1  goto  1100 
cal  1  SHIFT (0 , 1  1 
call  SHIFTM  ,21 
goto  SS00 
I  100  coni  mue 
ten-1  0dl 
hrenth-ht /ten 
dv-ct*1  0d-3 

n-2*nc  t 

do  1 200  i -2  ,n 

i f  ( vc0 1 ( i  1  It  vc0 1 1 i -  1  1  )  goto  1 200 

j  -  i  -  I 

goto  1210 
1  200  com  mue 
j-n 

1210  com  mue 

vbase-vc0i (j  )+htanaf 
v0-vbase 

cal  1  SUBVX  (net  ,zt  ,vc0t  ,ncc  ,zc  ,vc0c  ,smaf  .cosaf  ,tanef  ,secaf  , 

A  htanaf  ,0  ,i  f  t  vp  .nerr  I 

*************************************** *** ******* * ********** ************ 

*  i f  ( f0  ne  zero)  goto  I2S0 

*  cal  1  SHIFT (2  ,01 

*  nerrf-0 

*  goto  6000 
*1250  com  mue 

***** ************************************************* ****************** 
fbase- T0 

abs  fb-dabs ( fbase  ) 
fred-absfb 
flint-  - f 


04 

-4 


if  l i f t yp  ne  II  f I im- f 1 im+s tp 
if  I  i  f  I  yp  eq  f  I  in-  f  1  »m*yli  t  +s4 

************************************************************************ 

*  if  I i f i yp  ne  2  I  go l o  1 500 

*  len-LENSI  f  .cosaf  ,smaf  ,sip  ,ci/stp  .hi  I 

*  if  Hen  gi  zero  I  goto  1320 

*  ctht-ci/ht 

*  v0-hi *TANI <c th t  , f*c thf /s tp  )+c t 

*  goto  1350 

*  I  320  coni inue 

*  v0-c t * ( one- len/s t p 1 *h t anaf 

*  1 350  con t inue 

*  v0-dmax I ( v0  .vbose I 

*  call  SUBVXInct  .zi  .vc0t  ,ncc  ,zc  ,vc0c  .sinaf  .cosaf  .tanaf  .secaf > 

*  A  htanaf  ,0  ,2  ,nerr  ) 

*  v 1  - v0+  t  en*dv 

*  call  SUBVXInct  .zt  ,vc0t  .ncc  ,zc  ,vc0c  .sinaf  .cosaf  , tanaf .secaf , 

*  A  h tanaf  .1  ,2  ,nerr  I 

*  goto  5500 

*  1 500  con  t i nue 

************************************************************************ 
if  (fbase*flim  ge  zero  I  goto  3000 

*  «r i tel  10  .*  I  2  ' 
de 1 v 1 *h  t  en  t  h 

2100  cont  mue 

v 1 »c  t  +h  t ana  f +de 1 v 1 

cal  1  SUBVXInct  ,z  t  ,vc0t  ,ncc  ,zc  ,vc0c  .sinaf  .cosaf  .tanaf  .secaf  > 

A  h  t  ana  f  .1  ,  i  f  l  yp  .nerr  I 
if  ( f0*  f  1  It  zero  I  goto  “1000 
col  1  SHIFT (0 ,1  ) 
de 1 v I -de 1 v 1  *  t  en 
goto  2100 

3000  continue 

*  *r i tel  10  ,*  I  '3  ' 
n  i  t  -0 

de 1 v I -dv 

ra tmox-c  t  /  (stp*stnal  1  I 
v I -vbase+del vl 
goto  3150 
3100  cont  mue 

rat  -  I v0-vbase  )/ I f0- fbose  I 


(JJ 

00 


if  I  dabs (rail  at  rat max)  goto  3500 
v I -vbase- fbase*rat 
3 1 50  con  t i nue 

cal  1  SUBVXinct  ,21  ,vc0t  ,ncc  ,zc  ,vc0c  .sinaf  ,cosaf  ,tanaf  ,secaf  , 

A  h  t  ana  f  ,  I  ,  i f  t  yp  ,nerr  ) 
f red- dm  ini ( fred  ,dabs (fill 
if  (f0*f)  It  zero  I  goto  4000 
if  (dabs(fi)  ge  absTb)  goto  3500 
de 1 v 1  - v I  - v0 

if  l n i t  1 e  1 )  goto  3)60 

if  (dabs (one-del v*de I v 1 /del v0**2 )  It  one/ten)  goto  5500 
3)60  coni i nue 

call  SHIFT (0  ,1  I 
de I v-de 1 v0 
de 1 v0-de 1 v  I 
n  1 1  -m  t  ♦  I 
goto  3100 

3500  continue 

*  »r  i  tel  10  i*  I  '  1  ' 

if  (mt  eg  0  ond  iftvp  eq  I  and  n*t  eq  0)  goto  6000 

v 1 ow- vbase 

h l erm-h  f en  f h 

do  3600  i  vmt -I 

nd i v-7- i v int 

vh  i  gh-c  f  (“i  t  ana  f  »h  t  erm 

delv-vhigh-vlow 

n-  ) 

do  3550  i -  I  ,ndi v 
v 1 *v 1 ow*hal f *de l v 
do  3510  j-1  ,n 

call  SUBVX  (net  ,z  t  ivc0t  >ncc  ,zc  ivc0c  .sinaf  ,cosa  f  ,t  anaf  .secaf  . 

A  h  t  ana  f  ,  I  ,  i f  t  y p  ,nerr  ) 
if  (f0*fl  It  zero)  goto  1000 
f red-dm i n I ( f red  .dabs (fill 
v ) - v ) +de 1 v 
3510  cont inue 
n-n*n 

de 1 v-hal f  *de 1 v 
3550  continue 

t*t*ttt*»t**t**t**i*****tt***tt*:M********ttt******t**tt**tt*tt$*t***tt* 

*  v ) - vhi gh 

*  call  SUBVX  (nc  t  ,z  t  ,vc0t  ,ncc  .zc  .vc0c  ,s  inaf  .cosaf  ,  tanaf  .secaf  . 


*  4  hi anaf  ,1  ,i  f  typ  ,nerr  ) 

*  if  (f0*fl  It  zero  I  goto  4000 

*  fred-dminl ( fred  ,dabsl f I  )  I 

$t%t**t**t*tt*tttt**t*****t***t***t*tt*t*tt*t**ttttt**tttttt*tttttttt»t* 

v  l  o«*-vh  i  gh 
h i erm-h  t erm*  t  en 
3600  coni inue 
go i o  6000 

■1000  con  i  i  nue 
<  »r i ie( 10  ,*  )  '4  ' 

n  i  i  - 1 

4 1 00  con l i nue 

if  (iflyp  ne  4)  goto  4200 

if  <dabs(v0-vl)  at  dv  or  dabs(rat0)  gi  dv/stp)  goto  4200 
j - i 1  hi  - i I h0 

if  I j*j  ne  1  )  goto  4200 
J*l3-j  1/2 

n-jlhljl 
f-zero 
i s-3*ncc 
do  4  120  i - 1  ,n 
f - f ♦zc ( i s  l 
i s- i s-3 
4 1 20  con l i nue 
v0sav- v0 
v l sav-v 1 
f 0sav- f0 
f 1 sav- f 1 
f0-ih0- f 
fl-lhl-f 

call  SECV I T (nc i  ,z i  ,vc0t  i  ncc  ,zc  ,vc0c  .snafh  ,csa  fh  ,tnafb  , 

4  scafb  ,hinafb  ,3  .nerr  I 
if  (nerr  ne  01  goto  4)40 
call  SR  I  SR ( y k i »z t I  1 2  )  .zero  I 
ce-h*i tana7-zt I i tarn  I  )-c3 
m-2*  (ncc  j  I 

if  Ice  It  vc0c 1 i n ♦ 1  )  or  ce  gt  vc0c(in))  oto  4t40 
nerr  f -0 
goto  6000 
4  I  40  con  t i nue 
( -do 

v0- v0sav 


/  Vi 


vl-vlsav 
f0- f0SOV 
f 1  * (Isav 
i  lh( j  )-n 
j-3-j 

i lh( j  1-n+l 
4200  com  i  Due 

v2-hal f* ( v0+v1  ) 

if  (nit  gt  3)  v2- v 1  - f I *rat 0 

cal  1  SU8VX  (net  ,z  t  ,vc0 1  ,ncc  ,zc  ,vc0c  ,s  inaf  ,cosa  f  ,  t  anaf  >secaf  , 
4  htanaf  ,2  ,i  f  t yp  ,nerr  I 
i-l 

i f  ( f2*  f0  gt  zero  I  i -0 

call  SHIFTU  ,21 

rat l-lvl-v0)/( fl-f0) 

if  (dabsl f0)+dabs( fl  1  It  eps*ten)  goto  5500 
if  (nit  ge  5  and  dabs ( ra 10/ ( ra 1 0-ra t I  1  1  at  ten  and 
4  (iflvp  ne  f  or  i I h0  eq  i 1 h I  ))  go > o  5500 
rat0-rat 1 

ni t -ni t  +  1 

goto  4100 
5500  continue 

call  SECV  I  T  (nc  t  ,z  t  ,vc0t  ,ncc  ,zc  ,vc0c  ,Sinaf  ,cosa  f  ,  t  ana  f  , 

4  seca f  ,h  t  ana  f  ,  i f t  vp  ,nerr  f  1 

6000  continue 

if  ( fbase  It  zero)  fred-  -fred 

return 

end 


ei  sys  f  inal/ (2for/shi  f  I  forM 
subrounne  SHIFT  (i  ,j  ) 

************************************************************************ 
implicit  integer *2  1“) 
implicit  double  precision  la-zl 

integer *2  i  ,j 

integer*2  ivs 

double  precision  v0  ,vl  ,v2  ,f0  ,fl  .  f  2  ,(  >eps 
common  /VSEC/  v0  ,v I  ,v2  .f0  , fl  ,(2  ,(  >eps  ,ivs 
double  precision  varray (3  I  .farray ( 3 ) 
equivalence  (v0  ivarray J  , <  f 0  , (array  I 

integer *2  i lh0  ,i lhl  >i lh2  ,i 1 

double  precision  lh0,lhl  ,lh2  ,ce 

common  /VSCOlL/  lb0  .lhl  ,lh2  .ce  ,  i lh0  ,i lhl  ,  i )h2  .  i I 

integer*2  i 1 h  C  3  1 

double  precision  lhl3l 

equivalence  1 1 lh  ,  i lh0  I  ,  1 lh  ,  lh0  I 

i n t eger*2  i x  . j x 

************************************************************************ 

i x-  i  +  I 

JX-J+1 

varray ( i x  l-varray ( jx 1 
f array ( i x  I- farray  < j  x  I 
lhl ixl-lhljxl 
ilhlixl-ilhljx) 

return 

end 

* 


-Tv 

ro 


ei  sys  f  mal  /  t2for/subvx  forM 

subrout  me  SUBVXInct  >zt  >vc0f  ,r>cc  iZC  ,vc0c  .sinaf  ,cosaf  ,  tanaf  .secaf  , 

A  hianaf  .index  ,t f lyp  ,nerr I 

************************************************************************ 

implicit  double  precision  (a-z I 

i n  teger *2  nc l  ,ncc  .index  , i f l yp  ,nerr 

double  prec i si on  z  t (25  I  .vc0l (6  )  ,zc (25  )  ,vc0c (6  I  ,s inaf  .cosaf  , lanaf  , 

A  secaf  .hianaf 

double  precision  pi  ,hal fpi  , degrad  .raddeg  .zero  .one  ,hal f 
integer *2  i zero  ,ione  ,i two 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

A  i zero  ,  i one  ,  i t  wo 

double  precision  v0  ,vl  ,v2,f0,fl  ,  f 2  , f  .eps 
common  /VSEC/  v0  ,vl  ,v2  , f 0  ,fl  .f2  ,f  .eps 
double  precision  varray ( 3  I  , f array ( 3  ) 
equivalence  Iv0  .varray  1  ,(f0,farrav) 

integer*2  ilh0,ilhl  ,ilh2,il 
double  precision  lh0  ,lhl  ,lh2  .ce 

common  /VSCOIL/  lh0 , 1 h 1  , 1 h2  ,ce  ,i lh0  ,i lhl  Ih2  ,i I 
m teger *2  i lhl 3  I 
double  precision  lhl 3) 
equivalence  ( i lh  ,  i lh0  1  .  ( lh  ,  1 h0  ) 

integer *2  ix 

************************************************************************ 
i x- i ndex+ I 
Z  t (2  l-varray ( i x 1 

call  CALC2(nct  .zi  ,vc0t  .sinaf  .cosaf  .  t  ana  f  .secaf  ,ht  ana  f  ,  i one  ,nerr  ) 
go  to  (110.1 20  >  1  30  . 1 30 1  .  i  f  t  yp 
1  1 0  cont  mue 

fval-zt (11) 
goto  200 
I  20  cont  mue 

fval-zt (121 
goto  200 
1  30  cont  mue 

fval-zt ( 121-zt ( 1 1  )* tanaf 
!h(ix)-fval 

if  (iftyp  eq  3)  goto  200 


* 


200 


ce*WGTH( fval  >ncc  ,zc  ivc0c 

C?il!  c^R,SR«ce  ,zt  ,fvol  ) 
i lht ix  l-i 1 


com  muG 

f array ( ix J - f va 1  - f 

return 

end 


ft/ 


/Mh 


ei  svs  f inal/t2for/wgth  forH 

function  WCTHUenh  ,nc  ,z  ,vc0  ) 

************************************************************************ 

implicit  double  precision  (a-z) 

integer*2  nc 

double  precision  wgth  ,lenh  ,z  (25  1  !vc0  (6  1 

double  precision  pi  ,halfpi  , degrad  .raddeg  ,zero  , one  , ha 1 f 
integer*2  izero >ione  ,i two 

common  /VCONST/  pi  ,hal fpi  >degrad  .raddeg  ,zero  ,one  ,hal f  , 

S  i zero  .  i one  ,  1 1  wo 

integer *2  i lh0  ,i Ihl  , i lh2  , i 1 
double  precision  Ih0,lh1  ,lh2.ce 

common  /VSC01L/  lh0  ,lh1  ,lh2  ice  >i lh0  ,i lhl  ,i Ih2  >i I 
integer*2  ilh<3) 
double  precision  lh(3) 
equivalence  ( 1 1 h  ,  ■ 1 h0  I  ,  ( l h  ,  I h0 I 

mteger*2  i  ,is  ,in 

************************************************************************ 
1 enl -zero 
i s-3*nc 
i n-2*nc 
do  100  i-l  >nc 
lenl • lenl +z  l  is  I 

if  It  1 t  nc  and  lenh  gt  l enl 1  goto  20 
wgth-vc0 ( in |+ ( lenh- len1+z(is))$zTiS+l  1 
i  T- 1 

goto  110 
20  com  inue 
i s- is-3 
in-m-2 
100  com  inue 
I  10  coni inue 
ret  urn 
end 


4>- 

<S\ 


/fe¬ 


et  sys  f inal/t2for/cer isr  forH 

subroutine  CERISR(ce,zt  ,ybb  1 

************************************************************************ 

implicit  double  precision  <a-zi 

double  precision  ce  ,zt (2S 1  ,ybb 

i nt eger*2  i  leg  ,  is  t  ,nca  ,ncb  ,n#a  ,n*b  ,  1  sol  ,  ibrnch  ,uz  (5  ) 
double  precision  z (67  I  ,cz  icx  ,d  .  t a  ,  tb 

common  /VCLOB/  i  leg  list  ,nca  tncb  ,z  ,cz  ,cx  ,d  ,ta  ,tb  ,n*a  ,n»b  , 

4  i sol  , ibrnch  ,uz 
double  precision  za(2S  )  ,zb(25 ) 
equ i valence  ( z ( 1  )  iHa (1  !  I  ■  ( z ( 26  I  iZb ( 1  ) ) 

double  precision  ha  ,al  a  ,va  ,s  I  a  ,w  I  a  ^c  t  o  ,s2a  >«2a  >c2a  >s3a  >w3a  > 

A  xa  ,ya  ,xla  ,x2a  ,x3a  ,y1a  ,y2a  ,y3a  , 

4  t  ana2a  ,  t  ana 3a  ,  t  anala  .  t  anaSa  ■  t  ana6a  ,  1  a  iph i a 
equivalence  l za ( 1  I  fha  I  ,  ( za (2  1  ,al  a  ,va  I  > 

4  1 20  ( 3  )  ,sl  a )  i  (za  M  )  ,w  I  a  )  ,  l  za  (5  )  .c  1  a  1  , 

4  lza(6)  ,s2al  ,(za(7)  ,w2a  I  i(za(8)  ,c2al  , 

4  ( za  (9  l  is 3a  l  ,  Cza <10  (  ,*»3a  1  ,  (za<  I  l  )  ,xa )  , ( 2afl 2  )  .va  )  , 

4  iza  1 1  3  1  ix  1  a  )  •  t  za(  t  1 )  >x2a  I  ,  ( za  <  1 5  )  ,x3a  )  i 

4  (  za  ( 1 6  I  ,y  1  a  1  , 1  za  ( I  7  )  ,y2a  I  ,  ( za  (  I  8  1  ,y  3a  1  , 

4  <  za  ( 1 9  1  ,  tana2a  I  ,  ( za  (20  )  ,  tana3a  )  ,  ( zal 2 1  )  ,  >  anala  )  , 

4  ( za ( 22  l  1 1  ana5a  1  ,  ( za ( 23  I  ,  i ana6a  I  ,  ( za ( 21  )  > 1  a  •  ,  ( za ( 25  )  ,ph i a  ) 

double  precision  hb  ,alb  ,vb  (slb  ,wlb  ,c!b  ,s2b  >w2b  >c2b  ,s3b  ,w3b  , 

4  xb  ,yb  >xlb  ,x2b  ,x3b  ,y  lb  ,y2b  <y3b  , 

4  t  ana2b  ,  t  ano3b  ,  t  analb  ,  t  anoSb  ,  t  ana6b  ,  1 b  .ph i b 
equivalence  ( zb ( 1  1  ,hb  I  >(zb(2  I  iOlb  ,vb  I  > 

4  ( zb  ( 3  )  ,s  1  b  )  ,  ( zb  M  1  ,w  1  b  )  ,  ( zb  ( 5  I  ,c  t  b  )  , 

4  (zb <61  is2b  1  .  ( zb l  7  )  ,w2b  I  ,  ( zb ( 8  I  ,c2b  1  . 

4  ( zb (9  l  is3b  I  , (zb ( 10  1  ,w3b  I  ,  ( zb  (  M  )  ,xb  )  ,  ( zb ( 1 2  )  >yb  )  i 

4  (zb  ( I  3  1  ix  lb  I  ,  (zb ( 1 1 1  ix2b  1  >  ( zb  (151  ,x3b  )  , 

4  (zb(  16  I  ,ylb  1  ,  ( zb (17)  ,y2b  1  ,(zbM8)  ,y3b)  , 

4  (zb ( 19  I  i  tano2b I  ,  (zb (20 1  i  tana3b )  ■  ( zb (2 1  1  ,  t analb  )  , 

4  ( zb (22  l  i tana5b  1  . (zb (23  1  , tona6b l  . l zb 1 21 1  ,1b  1  ,  ( zb ( 25 1  ,phib ) 

double  precision  coi  1  ,slp  ,frct  .c3  ,s1  ,w1  ,x1  ,y1  ,iana7  , tana8  ,1  , 

4  h,phih,rfot  ,xtot  ,Ztot  ,do 

equivalence  ( z (51  )  ,coi l  )  ,  (z (52 l  ,s  lp  I  ,  ( z (53  )  ,frct  )  ,  (z (51 1  ,c3)  , 

4  (z(551  ,s1 1  ,(z(56)  ,w1 1  ,(z(57l  ,x1 1  ,(z(58l  ,y1 1  . 

4  lz(59)  ,tona7)  ,(z(60)  , tanaB)  >(z(6!  1  ,1  I  , 

4  ( z  (62  1  ,h  1  ,  (z  (63  1  ,phih)  , 

4  (z (61 1  ,r tot  1  , <z (6b  I  ,x tot  I  ,  (z (66 1  ,z  tot  1  ,  (z (67  1  ,do 1 


(T'' 


\ 


pi  svs  f mal/t2for/secvi t  forH 

subrouf  me  SECVIT  (nci  iZt  ,vc0i  ,ncc  ,zc  ,vc0c  , 

4  s  i  na  f  icosa  f  ,  i  ana  f  ,seca  f  ,h  t  ana  f  ,  i  f  t  yp  .  i f  a i 1  I 
****** ********************************** ****** ************************** 
implicit  integ er*2  (») 
implicit  double  precision  (a-z) 

integer *2  net  ,ncc  , i f typ  ,i fai 1 

double  precision  z i (25  I  ,vc0t (6  I  ,zc (25  )  ,vc0c (6  1  , 

4  smaf  ,cosaf  .lanaf  .secaf  ihianaf 

double  precision  pi  ,hal fpi  .degrad  .raddeg  .zero  , one  , ho  1  f 
inieger*2  izero  ,  mne  .  1 1 wo 

common  /VCONST/  pi  .halfpi  .degrad  .raddeg  .zero  , one  ,hal f  , 

4  i zero  ,  i one  .  i i wo 

mieger*2  ivs 

double  precision  v0  ,v I  ,v2  .f0  ,f I  .  f  2  ,f  .eps 
common  /VSEC/  v0  ,v !  ,v2  .f0  ,f  1  , f 2  ,f  .eps  ,ivs 
double  precision  vorray ( 3  )  ,  far ray ( 5  ) 
equ i va 1 ence  (v0  .varray  I  ,( f0  ,  far ray  I 

mieger*2  nit  ,nerr  ,nr 

equivalence  Inerr  ,nr  I 

************************************************************************ 

*  wr  i  i  e  ( 1 0  i*  I  'SEC  V  IT'  fV0,f0,vl  ,fl  .f.ifiyp 

i fa. 1-0 
n  i  t  -  1 

1 000  con  1 1 nue 

v2-v  I  -  f  1  *  ( v  1  -v0  )/  (  fl  -  f0  ) 

10(0  com  mue 

call  SUBVX  (nc  i  .z  i  .vc0 1  ,ncc  .zc  >vc0c  ,si  na  f  ,cosa  f  ,  t  ana  f  .sec  a  f  . 

4  h lanaf  .2  >i  f  lyp  ,nerr  ) 

*  wrile(10,*l  'CALC2',nit,v2if2.nerr 
i I  Inerr  eq  01  goto  1200 
nr-nerr-nerr/3 

v2-hal f * ( v 1 ♦ vc0 1 (nr  )+hi ana f I 
goto  1010 


1200  continue 


IW 


if  (dabs I f2)  It  eps)  goto  2000 

if  (rut  gt  50)  goto  1900 

cal  1  SH 1  ? T  ( 0  ,1  I 

cal  I  SHIP  r  ( 1  ,21 

n i t  »n 1 1 ♦ 1 

go  t  o  1 000 

1900  continue 
i  f  a  i  I  -  t 

2000  cont inue 
ret  urn 
end 

* 


4- 

~~o 


fbo 


ei  svs  f inal/t2for/stefab  forH 
subroutine  STEEA8 

************************************************************************ 
implicit  integer *2  (») 
implicit  double  precision  (a-zl 

integer*2  ileg.ist  ,nca  ,ncb  ,n»a  >nwb  ,  i  sol  .ibrnch  ,uz  IS  ) 
double  precision  z  (67  )  ,cz  ,cx  ,d  .  t  a  .  t  b 

common  /VCLOB/  i  leg  , i s  t  ,nca  ,ncb  ,z  ,cz  >cx  ,d  ,  t  a  ,  t b  ,n»a  ,n»b  ■ 

4  isol  ,ibrnch  ,uz 
double  precision  za(2S  I  ,zb(25  I 
equivalence  ( z ( 1  I  .za< 1  I  )  >(2(26)  ,zb (1)1 

double  precision  ha  ,a  I  a  ,  va  ,s  I  a  .w  I  a  ,c  1  a  ,s2a  >w2a  ,c2a  ,s3a  ,w3a  , 

4  xa  >ya  >xta  >x2a  ,x3a  ,y1a  iy 2a  ,y3a  , 

4  t  ana2a  ,  f  ana3a  ,  t  ana4a  >  f anaSa  ,  t ana6a  .  1  a  ,ph i a 
equ  i  va  1  ence  ( za  ( 1  )  ,ha  1  ,  ( za  ( 2  I  ,a  1  a  >va  I  , 

4  ( za  ( 3  1  >s  I  a )  >  ( za  14  1  ,w  I  a )  ,  ( za  ( S  1  ,c  I  a )  , 

4  ( za(6  )  ,s2a  1  ,  (za ( 7  )  ,»2a  I  ,  ( za (8  I  ,c2a  )  , 

4  (za (9  )  is3a  1  i  (za ( 1 0  )  ,*3 a  )  ,  (za ( l I  )  ,xa  1  ,  ( za ( 1 2  )  .ya  l  > 

4  ( za(  1  3  I  ,x  I  a  I  ,  ( za  1 1  4  I  ,x2a  )  ,  ( za  ( 1 5  )  ,x3a  )  , 

4  (za  ( 1 6  )  ,y  1  a  I  ,  (za  1 1  7  )  ,y2a  )  ,  l  za  1 1 8  )  ,y  3a  )  , 

4  (za(19  1  ,tana2al  ,(za(20)  ,tana3a)  >(za(2'  )  ,iana4a>  , 

4  ( za (22  1  ,  tanoSa  )  ,  I za (23  1  ,  tana6a  I  ,  ( za ( 24  )  .  1  a  I  .  I  za 1 25  )  ,phia  ) 
double  precision  hb  ,a(b  .vb  ,slb  ,*lb  ,ctb  >s2b  ,*2b  ,c2b  >s3b  ,«3b  > 

4  xb  ,yb  ,x)b  ,x2b  ,x3b  ,y1b  iy2b  ,y3b  , 

4  t  ana2b  ,  I ana3b  1 1 ana4b  .  t  anoSb  ,  t ana6b  ,  I b  ,ph i b 
equ i valence  ( zb ( 1  )  ,hb  1  ,  ( zb (2  1  ,a 1 b  ,vb  1  , 

4  ( zb  ( 3  )  ,s  l  b  )  >  ( zb  ( 4  )  ,wlb)  ,(zb(S)  ,c(b)  , 

4  ( zb  (6  1  ,s2b  )  ,  ( zb  (  7  1  ,w2b  I  ,(zb(8)  ,c2b)  , 

4  ( zb (9 )  ,s3b I  > (zb ( ( 0 l  ,»3b  I  .  (zb ( l I l  ixb  I  ,  (zb ( 1 2  t  ,yb )  i 

4  ( zb  ( 1 3  )  ,xlb)  ,(zb(M)  ,x2b  I  ,(zb(  IS  )  ,x3b  )  , 

4  (zb ( 16  I  ,y  lb  1  , (zb ( I  7  I  ,v2b  l  ,(zb(18l  ,y3b)  , 

4  (zb (19)  .tana2b)  ,(zb(20)  >tona3b)  .(zb (2 1  )  ,  tana4b)  , 

4  ( zb ( 22  I  ,  t  ona5b  1  ,  ( zb (23  I  .  t  ana6b  )  .  ( zb ( 24  )  ,1b)  ,  I  zb 1 25 )  ,ph i b ) 

double  precision  coi 1  ,slp  ,frct  ,c3  ,s4  ,w4  ,x4  ,y4  ,iana7  , tana8  ,1  , 

4  h.phih.rlot  ,xtot  ,ztol  .do 

equivalence  ( z (51  )  ,co il  1  ,(z!52l  ,slp)  ,(z(53)  ,frci  )  ,  ( z ( 54  )  ,c3)  , 

4  (z(S5)  ,s4)  ,(z(56)  ,»4)  ,  I  z  1 57  )  ,x4  )  ,(zl58)  ,y4  )  , 

4  ( z ( 59  )  ,  t  ana7  )  ,  ( z ( 60  )  ,  t  ana8  )  .  ( z ( 6 1  1  , 1  )  , 

4  I  z  ( 62  )  >h  1  ,  ( z  ( 63  )  ,ph  i  h  )  , 

4  ( z (64  )  ,r  tot  I  , ( z (65  1  ,x  to t  I  ,  ( z (66  )  ,z  tot  )  ,  ( z 167  )  ,do ) 

integer*2  uzl  >uz2  ,uz3  ,uz4  ,uz5 

equivalence  (uz ( 1  )  >uz(  1  , (uz (2  1  ,uz2 )  , (uz ( 3 )  ,uz3 )  , (uz (4 )  ,uz4 ) , 


O 


A  (uz (5  I  ,uz5 ) 

double  precision  pi  .halfpi  , degrad  ,raddeg  .zero  ,one  ,hal  f 
mteger*2  izero  ,ione  ,i t»o 

common  /VCONST/  pi  ,hal fpi  .degrad  ,raddeg  ,zero  ,one  >hal f  , 

A  izero  iione  , i two 

double  precision  de 1 y k  . t mod  ,ha I f d  ,dsq 
common  /VANCH/  delyk  ,  t  wod  ,ha  1  f  d  ,dsq 

double  precision  snphih  ,csphih  ,snafh  .csafh  .tnafh  .scafh  ,dsnph 
common  /VHDIR/  snph i h  ,csph t h  ,sna fh  ,csa fh  , l na f h  ,sca f h  ,dsnph 

double  precision  epsvigamma.se 
integer *2  ia.ib.ie 

common  /VCMPD/  epsy  .gamma  ,se  ,  i a  .  i b  ,  i e 

double  precision  sa  ,sb  .ca  ,cb  ,vc0a  1 6  1  >vc0b  ( 6  )  , 

5  eex0  ,eez0  ,eey0  ,a0  ,b0  ,ph  i  a0  .ph  i  b0 
integer *2  icase 

common  /VSPIO/  sa  .sb  ,ca  .cb  ,vc0a  ,vc0b  > 

A  eex0  ,eez0  ,eey0  .a0  ,b0  ,phia0  ,phib0  , 

A  icase 

double  precision  a  ,b  .snphi  .tnafa  .tnafb  . 

A  seca7  ,seca8  ,ut  ,st  ,yk  t  ,zk  t  ,eex  ,eez  ,eey  .ybuoy 
common  /VCSSHP/  a. b, snphi  .tnafa  .tnafb  , 

A  seca7  ,seca8  ,ut  ,st  ,yk  t  ,zk  t  ,eex  ,eez  ,eev  .ybuoy 

inteaer*2  ivs 

double  precision  v0  ,v1  ,v2  ,f0  ,f 1  ,f 2  ,f  .eps 
common  /VSEC/  v0  .v 1  .v2  ,  f0  ,  f 1  ,  f2  ,  f  .eps  ,i vs 

double  precision  xred 

integer*2  i s i df  .nerra  .nerrb 

common  /VSTAB/  xred  ,  i s i d f  .nerra  .nerrb 

mteger*2  nit  , i point  ,i  .ifail  .iysq  ,is*l 

double  precision  jac(2,2) 

equivalence  ( jac  1 1  ,1  I  ,j  11  )  ,  ( jac  (  I  .2  1  .j  1 2  )  .  I  jac  1 2  .1  1  .  j  2 1  )  . 

A  ( jac  (2  ,2  I  ,j22  ) 


double  precision  zz(7) 
equivalence 

A  ( zz  (  I  I  ,esav  ,de  1  amx  ,de  1  on*  .anew  )  , 

&  ( zz  ( 2  )  ,ao  1  d  .de  1  a  .chnga  .anedge  I  , 

A  ( zz ( 3  )  .bold  ,delb  .chngb  .bnedae  I  ,  (  zz  ( 1 1  ,y  1  ,dcoe  f  f  )  ,  ( zz  (5  )  ,y2  t  , 

A  ( zz ( 6  )  , vsqo  ,y 1 x  .aedge  )  ,  ( zz ( 7  I  , v2x  .bedge  I 

double  precision  delx(2) 
equivalence  (dela.delx) 

equ i va 1 ence  ( cosmx  ,sca f  z  ,ha 1 f dd  ,s I  ,bsa v  ,de 1 «x  ,de 1  bmx  .del bn*  ,bnew )  , 
&  (csph i n  .hddcsp  ,xm id  , t emp 1  .ysqsav  ,de 1  )  ,  1 1 emp  .fact  ,ra t  ) 

funl (arga  ,argb  ,ar gd  l-arga*arga+dsq-argb*argb*argd*  tsnphih+snphih ) 

A  ♦arga 

************************************************************************ 

*  Set  constant  terms 

*****************************************************  ******************* 

epsysq-epsy*epsy 
zp9«0  9d0 

************************************************************************ 

*  Set  iteration  switch  for  subroutine  XSECV  to  zero 
************************************************************************ 

l  VS-0 

************************************************************************ 

*  Compute  upper  bounds  for  a  .b  ,  they  might  not  be  least  upper  bounds 
************************************************************************ 

amx-one 

bmx-one 

if  ( tnafh  le  zero  1  goto  120 
cosmx-dmaxl (csafh  ,one/SECNT (cz  I  I 
if  Icz  It  zero)  amx-cosmx 
if  (cz  gt  zero!  bmx-cosmx 
1 20  cont  mue 
amx-amx*sa 
bmx-bmxtsb 

************************************************************************ 

*  Compute  initial  guess  for  (a.b)  ond  assign  to  anew  ,bnew 
♦Set  (a.b)  equal  to  nearest  asymptotic  point 
************************************************************************ 

scafz-SECNT (cz ) 


I 


152. 


Irj  3 


csphin-csafh* (snphih+cz*inafh  l/scafz 
hal  fdd-hal  fd*scafz 
hddcsp-hal fdd*csphm 
t emp-hddcsp*hddcsp-hal fdd*hal fdd 

s I -dm i nl (dsqr i ( sa*sa+  temp  I  +hddcsp  ,dsqr  t ( sb*sb+  t emp ) -hddcsp I 

do  300  t  « I  ,7 

zz ( i  )-z (  i  ) 

300  con  t i nue 
ha-h 
sla-sl 

*  I  a- fca+cb  )/s I 
c 1 a-c3 
s2a-s3 

w2a-w4 

call  VCRI T  0 ( i two  ,za  ,vc0a ) 
f -do 

call  XSECV (2  ,za  ,vc0a  ,s I a»s2a  .vc0a ( I  I  ,nwa  ,ncb  ,zb  .vc0b  , 

&  snafh  ,csafh  .tnafh  ,scafh  ,2  it  fai  1  I 

xni d-za (II) 

t emp-xm i d*xm i d*ha 1 fd*hal fd 
t  emp I -xm i d*dsnph 
anew -dsqr  t ( t emp- r  emp 1  I 
bnew-dsqr  t ( t emp* t  emp I  I 
a-ha 1 f  * ( anew*bne»-dsnph  i 
b-a«dsnph 

do  500  i—l  ,7 
z ( t  l-zz ( t  I 
500  cont i nue 

call  VCR  I T0 (nca >za  ivc0a i 

*  Beginning  of  code  for  Steffensen  iteration 

***:M****tit*t«*tt****t**t**ttt**t*tt*t*******t**t****t*****t**tt******* 

*  Test  new  point  la  ,b  I  for  validity  via  subroutine  CALC3  and  adjust 

*  if  necessary,  while  generating  error  vector  t  y I  ,y2 ) 

*  Point  (a,bl  lies  within  hyperbolic  region,  but  value  of  a  or  b 

*  may  be  too  large  Point  (aold,bold)  has  passed  test  with  CALC3 

n  i  t  -0 


in 

U> 


* 

* 


1000 


1010 


'ITER'  ,n  1 1 


,y  2> 


eq  0 
1200 
1  100 


or  iswl  eq  1 


100 


i ysq-0 
coni inue 
•riteUD  .#1 
*r  1 1  e  ( 1 0  i*1 
i  sw 1 -0 
con  r i nue 
iSidf-' 

cal  I  CALC3 (a  ,0  ,y  I 
ysq-y ' *y 1 *y2*v2 

if  (nerra»nerrb  eq  0  and  init 
i  or  ysq  1(  ysqo#1  1 d0 )  )  goto 
i  f  ini  i  eq  0  or  is*»1  eq  1  '  goto 
a-hal f* (a*aold 1 
b-hal f* (b*bold 1 
goto  1010 

^ emi-Smax 1 ( xr ed+xr ed  ,ha 1 f * l ha  I f d* ( one- soph , h )  -  a ) ) 
a-a+  temp 
b-b* i emp 
goto  1010 


1200  coni i nue 

,  f  (mt  eq  01  goto  2400 
, f  (  iswl  eq  0  or  ysq  1 t 


ysqsav  I  goto  1 250 


a-a'-av 
b-bsav 
y sq-y sqsav 
i  so  1 -0 
go  t  o  1 300 
1250  coot i nue 

i f  ( isnl  eq  0 


and  ysq  ge  zp9*ysqot  iysq-iysq‘1 


1300  continue 

i  f  ( i ysq  le  4  1  goto 

asav-a 

bsov-b 

vsqsav-vsq 

a-hal f* (a+b-dsnph  I 

b-o+dsnpn 

i s« 1 - 1 

i ysq-0 
goto  1010 


1400 


$ 

-£■ 


t 


************************************************************************ 

*  Finished  if  error  vector  is  sufficiently  small  or  current  test  point 

*  is  sufficiently  close  to  previous  test  point 
************************************************************************ 

1  -100  com  mue 

if  (ysq  It  epsysq I  goto  5000 
if  (ysq  it  epsysq*!  0d8  and 

A  dabs (one-a/aoi d ) +dabs ( one-b/bo 1 d !  It  1  0d-8)  goto  5000 

************************************************************************ 

*  Compute  deltas  for  Jacobian  matrix  estimate 
************************************************************************ 

if  (nit  eq  I  or  iswt  eq  II  goto  1500 
dela- < j 1 1*yl+jl2*y2 )*dsqr  t ( j2T*j21 +j22*j22  l/det j 
de lb- ( j2 1 *y I ♦ j22*y2 )*dsqr  t (jl l*jl l+j!2*j!2 )/de  t  j 
goto  2000 
1500  continue 

de la-dsqr  t (hal f  *ysq I 
delb-dela 

************************************************* *********************** 

*  Adiust  deltas  as  necessary 

************************************************************************ 

2000  continue 

*  write  (10,*  I  '  ini  t  del  ’  ,dela  ,delb 

ra i -dmax 1 (one  ,epsy/dabs (dela  1  ,epsy/dabs  t de I b  )  ) 

dela-rat*dela 

delb-rat  *delb 

delmx-dminl (dabs(a-b+dl  ,dabs(b-a+dl  ,a+b-dl 
delamx-dminl (amx-a  ,delmx  ) 
delbmx-dminl (bmx-b  ,delmx  ) 

rat -dminl (one  ,de lamx/dabs (dela)  ,de lbmx/dabs ( de lb  l ) 

if  (rat  ne  one)  rat-0  1d0*rat 

delo-dela*rat 

delb-delb*rat 

2005  continue 

delanw-dela 

if  ( fun) (a+delanw  ,b  ,d)  gt  zero  I  goto  2)10 
cal  1  EDGPT (a  ,b  ,a+de)anw  ,b  ,d  ,aedge  ,bedge ) 
de 1 anw-aedge-a 
2110  cont  mue 

if  ( fun) (b >a+delanw  ,-d I  gt  zero)  goto  2120 


cal  1  EOCPT (b  ,o  ,b  ,a+delanw  ,-d  ,bedge  ,aedge  ) 
delanw-oedge-a 
21  20  coni  mue 

deibnw-de lb 

if  l funl (a  ,b+de Ibnw  ,d )  gi  zero  1  goto  2130 
cal  1  EDCPT  (a  ,b  ,a  ,b+delbnw  ,d  .aedge  ,bedge  ) 
de 1 bnw -bedge -b 
21  30  coni  mue 

if  ( funl (b+delbnw  ,a  ,-d 1  gt  zero  1  goto  2110 
cal  1  EDCPT lb  ,a  ,b+delbnw  ,a  ,-d  , bedge  .aedge  ) 
delbnw-bedge-b 
21 10  com  mue 

rat -one 

if  l del  a  eq  delanw  and  delb  eq  del bnw  I  goto  2160 
rat -dminl (dabs (de lanw/dela  1  .dabs ( de 1 bnw/de 1 b  )  1*0  I d0 
2160  coni mue 

dela-rat  *dela 
de 1 b-rot *de  1  b 

*  *r  i  te  (  1 0  ,#  )  '  f  in  de  1  '  .de la  .de lb  .rat 

*  if  ( funl (a+dela  .b >d  l  gt  zero  and  funl  (b  ,o  +  de  I  a  ,-d  I  gt  zero 

*  &  and  funl (a  ,b»delb  ,d )  gt  zero  and  fun! lb*delb  .a  ,-d )  gt  zero) 

*  <1  go  r  o  2 1 90 

*  dela-hal f*dela 

*  delb-hal f*delb 

*  goto  2005 
#2190  com  mue 

********************************** I**#*#*###*####**##****#**#****#****** 

*  Estimate  Jacobian  matrix 

************************************************************************ 
2200  corn  mue 
i  point- 1 
2205  corn  mue 

de 1 -del x ( i point  I 
i s i df- 1 

if  (del  It  zero)  isidf-2 
if  (ipomt  eq  2)  isidf-3- isidf 

call  CALC3(aM2-ipomt  )#de la  ,b+  < ipo in t -  1  )*delb,y1x  ,y2x) 
if  (nerro+nerrb  eq  zero  I  goto  2220 
delo-bal f#dela 
delb-hal f*delb 


1 51 


goto  2200 
2220  continue 

jac<  1  , i point  )-(y1x-y1 )/del 
jac(2  ■ipomt  )- (y2x-y2  )/del 
i po i n  t - i po i n  t ♦ l 

if  l i point  le  2)  goto  2205 

*  »r  i  t  e  1 1  0  ,*  )  'jac'  ,  j  1 1  ij12 

*  *ri  te(  10  it  I  '  'ij2lij22 

************************************************************************ 

*  Invert  Jacobian  matrix  and  compute  new  point  lanew.bnew) 

#i *********************************************************************** 

detj-jl I*j22-jl2*j2t 

temp-j 1 1 

j I  I  - j22/det  j 
j22- temp/det  j 

jl2-  -jI2/detj 
j  2 1  —  - j  2 1 /de  t  j 
anew-a- I j 1 1 *y 1 ♦ j 1 2*y2 I 
bnew-b-  Ij21*yl+j22*y2) 

*  «ri  ie(  10  ,♦  I  'inv',jll,j)2 

*  wr  itel)0,*)  '  >j2l  ij22 

************************************************************************ 

*  Adjust  ne*  point  lane*  ,bnew )  as  necessary 
************************************************************************ 

2A00  continue 

*  wr  1 1 e  ( 1 0  i*  1  '  i  n 1 1  new  p  t  '  ,ane»  ,bnew 
f  ac  t -one 

if  (dabs (anew-bnew I  It  d)  goto  2500 

fact-zp9 

dcoe  f  f -d 

if  (anew  gt  bnew )  dcoeff-  -d 

chnga-anew-a 

cbngb-bnew-b 

anew- (chnga* (b-dcoef  f  l-chngb*a 1/ (chnga-chngb  ) 
bnew-anew*dcoef f 
2500  continue 

*  write! 10  i*l  anew  , bnew 

if  (anew+bnew  gt  dl  goto  2600 

fact-zp9 

chnga-anew-a 

chngb-bnew-b 


i~n 


.1 


158 


anew- (chnga* (d-b )+chngb*a )/ (chnga+chngb ) 
bnew-d-anew 
2600  continue 

*  write  (10,*)  anew  >bnew 

if  ( f un I ( anew >bnew  ,d )  gt  zero)  goto  2800 
fact-zp9 

cal  1  EuGPT (a  ,b  ,anew  ,bnew  ,d  .anedge  .bnedge ) 
anew-anedge 
bnew-bnedge 
2800  continue 

*  write! 10  ■*)  anew  ,bne* 

if  ( fun  I (bnew  .anew  ,-d  )  gt  zero  I  goto  2900 
fact-zp9 

cal  1  EDCPT (b  .a  ,bnew  .anew  ,-d  .bnedge  .anedge  ) 
anew-anedge 
bnew-bnedge 
2900  continue 

*  write (10,*)  anew  , bnew 
anew-a+  fac I* (anew-a  ) 
bnew-b+  fact* (bnew-b  ) 

*  wr  i  te  ( 1 0  ,*  )  'fm  new  pt  '  .anew  ,bnew  .fact 

*  if  ( fun) (anew  , bnew  ,d )  gt  zero  and  fun)  (bnew  .anew  ,-d  )  gt  zero  I 

*  A  goto  3000 

*  anew-hal f * la+anew  I 

*  bnew-hal f * lb+bnew  ) 

*  goto  2600 
*3000  continue 

************************************************************************ 

*  Shift  values  and  return  to  beginning  of  Steffensen  iteration 
************************************************************************ 

aold-a 

bold-b 

vsqo-ysq 

a-anew 

b-bnew 

n  t  t -n 1 1  *  1 

goto  1 000 

5000  continue 
return 
end 


851 


/t'l 


ei  svs  f inal/t2for/calc3  forH 

subroutine  CALC3(a.b.yl  ,y2) 

tttttt^t****** ***********************************  *********************** 
i mp licit  integer *2  (*>) 
implicit  double  precision  (a-zl 

double  precision  a  ib  >yl  iy2 

i  n  teger  *2  i  1  eg  ,  i  s  t  .nca  .neb  ,n*a  ,n#b  ,  i  so  1  .  i  brnch  ,u;  ( 5  I 
double  precision  z(67  1  ,cz  ,cx  ,d  .ta  ,tb 

common  /VCL08/  1 1  eg  ,  i  s  t  >nca  ,ncb  .z  ,cz  ,cx  ,d  >  t  a  >  t  b  ,n»a  ,nwb  , 

A  i so  1  ,  i brnch  ,uz 
double  precision  za ( 25  )  .zb (25  ) 
equivalence  ( z ( I  I  ,za< I  M  ,(z(26  I  >zb( 1  )  1 

double  precision  ha  ,al  a  >va  ,s1  a  ,» 1  a  ,c  I  o  ,s2o  ,w2a  ,c2a  ,s3a  ,»3a  , 

A  xa  ,ya  .x  1  a  ,x2a  .x3a  ,y  1  a  .y2a  ,y3a  . 

A  t  ana2a  ,  t  anaia  ,  t  anaia  ,  t  anaSa  ,  t  ana6a  ,  1  a  ,ph i a 
equivalence  (za( t  I  .ha  1  ,(za(2>  .ala  .val  , 

A  (za  ( 3  i  ,s  la  I  ,  ( za  M  I  .w  la  1  ,  (za (5 )  ,c  la )  , 

A  (za(6l  ,s2a  I  ,(za(7)  ,w2al  ,(za(8l  .c2a)  , 

A  (  za  (9  )  ,s3a  I  ,  (  zo  (  10  I  .w3a  I  ,  ( za  1 1  I  )  ,xa  I  ,  ( za  (  I  2  I  .yal  , 

A  ( za  ( I  3  )  ,x  I  a  )  .  ( zo  (  M  )  ,x2a  )  ,  (za  (  I  5  1  ,x3a  )  , 

A  ( za  ( 16  l  ,y  I  a  l  ,  (  za  (  I  7  1  ,y2a  I  ,  ( zo  (181  ,y3a  )  , 

A  ( za ( 1 9  I  .  t ana2a  I  .  ( za ( 20  )  ,  t  ana3a  )  ,  ( za 1 2 1  )  .  t ana4a  )  , 

A  ( za (22  I  .  tanoSa  I  ,  ( za (23  I  ,  tana6a  I  .  ( za ( 2A  )  ,  1  a  )  > l za ( 25  I  .phi a  ) 

double  precision  hb  ,a!b  .vb  ,slb  ,wlb  ,clb  ,s2b  ,»2b  ,c2b  ,s3b  ,w3b  , 

A  xb  .yb  ,x  I  b  ,x2b  ,x3b  ,y  I  b  >y2b  .y  3b  , 

A  t  ona2b  ,  t  ana3b  .  t  anaib  ,  t  ana5b  ,  t  ana6b  ,  1 b  ,ph i b 
equivalence  <zb( I l  .hb )  ,  lzb(2)  ,alb  .vb)  , 

A  ( zb  ( 3  I  ,slb)  ,  l  zb  ( 1 )  ,wlb  l  ,(zb(5l  ,clb)  , 

A  (zb (6  )  ,s2b  I  , ( zb  l  7  )  ,w2b  1  ,(zb(8l  ,c2b  l  , 

A  (zb (9)  ,s3b  I  ,(zb(  10  I  ,«3b  I  ,(zb(  I  1  )  ,xb)  ,  I  zb  ( 1 2  )  ,yb  )  , 

A  t  zb  ( 1 3 )  .xlb)  ,  ( zb  (Ml  ,x2b  )  .(zbMSl  ,x3b>  , 

A  (zb ( 16  I  ,y lb  1  , ( zb  117  1  ,y2b)  ,  ( zb ( 1 8  )  .v3b  )  , 

A  ( zb (19  1  .tano2b)  .(zb (20  I  ,tana3bl  .(zb (21  )  ,  tanaAb)  . 

A  ( zb (22  1  .  tana5b  )  ,  (zb (23  )  ,tano6b  I  .  (zb (21  )  .  lb  I  ,  ( zb (25 )  .phib ) 

double  precision  cot  1  ,slp  ,frct  .c3  .sA  ,wA  ,xA  ,y1  ,tana7  ,tana8  ,1  . 

A  h.phih.rtot  ,xtot  .ztot  .do 

equi valence  (z (51  )  ,coi 1  I  . (z (52  I  .sip)  , ( z (53 )  , fre t ) . (z (51 ) »c3 l  . 

A  ( z  (55  l  .sA  )  .  ( z  (56  )  ,w4  )  ,  (  z  (57  )  ,xA)  ,lz(58)  ,yA!  , 

A  ( z ( 59  I  .  i an a 7  1  ,  ( z ( 60  I  .  t ana8  I  ,  ( z ( 6 1  )  ,  1  )  , 

A  (z  162  I  ,h)  ,  ( z  <63  )  .phihl  , 

A  ( z  (6A  )  ,r  tot  I  .  (  z  <65  I  >x  tot  1  ,  ( z  (66  )  ,z  t  ot  )  ,  ( z  (67  1  ,do  1 


-A 


A 


double  precision  pi  .halfpi  , degrad .raddeg  ,zero  iOne  ,hal f 
inleger*2  i zero  . i one  , i t no 

common  /VCONST/  pi  ,hal fpi  .degrad  ,raddeg  .zero  ,one  ,hal (  , 

A  izero  .tone  ,i two 

double  precision  delyk  ,  iwod  ihal  fd  .dsq 
common  /VANCH/  delyk  ,twod  ihal fd  ,dsq 

double  precision  sa  ,sb  ,ca .cb  ,vc0a (6 )  ,vc0b ( 6  )  , 

A  eex0  ,eez0 >eey0  ,a0  ,b0  ,phia0  ,phib0 
inieger*2  icase 

common  /VSP1D/  sa  ,sb  ,c a  .cb  >vc0a  ,vc0b  , 

A  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0  , 

A  icase 

inieger*2  iscopa  ,  iscopb >i tana  ii tanb  ,ie 
double  precision  epsy  .gamma  .se 

common  /vCMPD/  epsy  .gamma  ,se  ,  i scopa  .  t scopb  .  i  t ana  .  i i anb  ,  i e 

double  precision  qa  ,qb  .snphi  , t naf a  , t na fb  , 

A  seca7  ,seca8  ,ui  ,si  .yk  t  ,z k  f  .eex  ,eez  .eey  .ybuoy 
common  /VCSSHP/  qa  ,qb  .snphi  ,  l na f a  .  1 nafb  . 

A  seca7  ,seca8  ,ui  ,si  .yk  i  ,zk  i  ,eex  ,eez  .eey  .ybuoy 

double  precision  v0  ,vl  ,v2  . f0  ,  n  ,12  ,(  ,eps 
common  /VSEC/  v0  ,v I  ,v2  ,  f0  ,  f I  ,  (2  ,  f  ,eps 

double  precision  xred 

mteger*2  isidf  .nerra  .nerrb 

common  /VSTA8/  xred  . i s i df  .nerra  .nerrb 

i  n  t  eger  *2  ns  i  d 

equivalence  (sea  ,scb  , tana 7  l 

******* ***************************************************************** 
*  *r  I  tel  10  ,*  I  CALCS'  ,a  .b 
nerra-0 
nerrb“0 

cal  I  PHI A8ia  .b  .e*a-b*b  .dsq  ,  t»od  ,phia  ,phib) 
cal  1  HSPl I T 

,<  (ha  gi  zero  and  hb  gi  zero  I  goto  900 

nerra» I 


Ov 

O 


lb! 


nerrb- I 
goto  5000 
900  coni  mue 
ns  id- 1 

1 000  con  t i nue 

goto  ( I  1 00  , 1 200 )  , i s i d f 
1  100  com  mue 

sca-SECNT ( t nafa ) 
f -a 

cal  1  XSECVInca  ,za  ,vc0a  ,sa  >ca  ,nwa  .neb  .zb  ,vc0b  , 
4  tnafa/sca  .one/sca  ,  tnafa  .sea  ,1  .nerral 
if  (nema  eq  0)  goto  2000 
go  r  o  5000 
1200  continue 

scb-SECNT ( tnafb I 
f-b 

cal  1  XSECVlncb  .zb  ,vc0b  ,sb  ,cb  ,nwb  ,nca  ,za  ,vc0a  . 
4  mafb/scb  ,one/scb  .inafb  ,scb  ,1  .nerrb  1 
if  (nerrb  eq  0)  goio  2000 
goto  5000 
2000  com  mue 

if  (ns id  eq  21  goto  2200 
nsid-2 

i s i d  f  *3- i s i df 
goto  1 000 
2200  continue 

t  ana7- (c3+ha*za( i tana I+hb*zb ( i t  anb 1 )/h 
call  TR1SR 

v 1 -hal f* ( ya+vb )+y1-do 
v2-yb-va-del yk 
call  X4CALC 
5000  continue 

*  write  (10,*  I  'ENO  CALC3  ‘  .nerra  .nerrb  ,y !  .y2 

*  write!  1 0  ,*  I  va  .ya  ,vb  .yb 

*  wr  1 1  e  ( 1 0  >*  I 
re  turn 

end 


0\ 


lev. 


ei  sys  f inal/t2for/edgpt  forll 

subrout  me  EDGPT  (a  ,b  >aa  ,bb  ,d  ,x  ,y  I 

************************************************************************ 

implicit  double  precision  (a-z) 

double  precision  a  ,b  ,aa  ,bb  ,d  ,x  ,y 

integer *2  i  leg  as  t  ,nca  .neb  .nwa  ,nwb  . i  sol  .ibrnch  ,uz  IS  ) 
double  precision  z(67  )  ,c2  ,cx  ,qd  .ta  ,tb 

common  /VGLOB/  i  leg  ,ist  .nca  .neb  ,z  ,cz  ,cx  ,qd  ,ta  ,ib  ,nwa  ,n*b  , 

A  i sol  .ibrnch  ,uz 
double  precision  za (25  I  , zb (25  ) 
equivalence  (2(11  >za( I  II  > (z (26  I  ,zb( I  I  I 

double  precision  ha  ,ala  ,va  .sla  ,«la  >cla  ,s2a  ,w2a  ,c2a  ,s3a  ,»3a  , 

&  xa  .ya  ,x  I  a  .x2a  .x3a  ,y  1  a  ,y2a  ,v 3a  . 

A  t  ana2a  ,  t  ana3a  ,  t  anala  ,  t  ana Sa  .  t  ana6a  ,  1  a  .ph i a 
equivalence  (za(t  I  ,ha  I  ,(za(2l  .ala.val  , 

A  ( za (  3  i  ,s I  a  I  ,  ( zaM  I  ,wla  1  ,  (za<5  I  ,c  la  I  , 

A  <za( 6)  ,s2a)  ,(za(7)  ,i»2a)  ,lza(8)  ,c2o>  , 

A  ( za ( 9  i  ,s3a  )  ,  lza(  10  I  ,«*3a  I  ,  (zal  I  I  I  ,xa  I  .  I  zaM  2  )  ,va  >  , 

A  (zal  13  I  ,x  (a  I  ,  (zal  Ml  ,x2al  ,  (za  (15  I  ,x3al  , 

A  I zal 1 6 1  >y1 a  I  , (zal 1 7  I  ,y2a  I  .  ( za ( 1 8  l  ,y 3a  )  , 

A  lza(!9l  , tan a2a  1  .(zal 20  I  .tana3al  .(za(2l  )  ,  tana^a)  , 

A  (zal 22  I  ,tana5al  ,( zal 231  ,tana6a)  ,  (zal24)  ,1a)  ,  I zal 25)  ,phia) 
double  precision  hb  ,alb  ,vb  ,slb  ,wlb  ,clb  ,s2b  ,»2b  ,c2b  ,s3b  ,»*3b  , 

A  xb  .yb  ,xlb  ,x2b  ,x3b  .ylb  ,y2b  .y3b  , 

A  t  ana2b  ,  t  ana3b  ,  t  ana4b  ,  t  ana5b  ,  i ana6b  ,  l b  ,ph i b 
equ i va 1 ence  ( zb 1 1  I  ,hb  I  ,  l zb 1 2  I  .alb  . vb  I  , 

A  ( zb  ( 3  l  ,s  I  b  I  ,  ( zb  M  I  ,« I  b  I  ,  ( zb  ( 5  l  ,c  I  b  )  , 

A  (zb  16  )  ,s2b  I  » t zb (71  ,»*2b  I  ,(zb(8l  ,c2b)  , 

A  (zb (9  I  ,s3b  I  , ( zb (10)  ,w3b  )  ,(zb  ( 1 1  I  ,xb  i  .  ( zb  ( 1 2  )  ,yb  I  , 

A  <zb( 1 3  I  ,x lb  )  , (zb( M  )  ,x2b  I  ,(zb(15  )  ,x3b  I  , 

A  (zb (16)  ,ylbl  , ( zb ( 1 7  1  ,y2b)  ,(zbl  18)  ,y3b)  , 

A  ( zb ( 1 9  I  ,  t  ano2b I  .  t  zb ( 20 )  .  t ana3b I  ,  ( zb ( 2 1  I  ,  i ano*b  I  , 

A  ( zb ( 22 1  ,  t  ana5b )  ,  ( zb ( 23  )  ,  t  ana6b )  ,  ( zb  1 24  I  ,1b)  ,  I  zb ( 25 )  ,ph i b ) 

double  precision  coi  l  ,slp  .fret  .c3  ,s3  ,*4  ,x4  ,y3  ,iana7  , tanaS  .1  . 

A  h  ,phih  ,rtot  ,xtot  ,ztoi  .do 

equivalence  lz(51  I  .coil  )  >(z(52l  ,slp)  >(z(53>  ,frct  )  .  I  z  ( 54  )  ,c3)  . 

A  (z  (55  I  ,s4  )  ,  (z  (56  I  ,«M 1  ,(z  (57  I  ,x1 )  .  I  z  (58  I  ,y*  I  , 

A  (z (59  I  ,  tana 7  I  , (z (60  I  ,  tana 8 )  .  ( z 16 1  I  ,  1  )  . 

A  ( z  (62  I  ,h  )  ,  ( z  (63  I  .phihl  , 

A  ( z (64  I  ,rtot  I  .  ( z  ( 65  I  >xtot  I  >(z(66)  .ztot  I  >(z(67)  ,do  I 


l 
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double  precision  pi  .halfpi  .degrad .raddeg  .zero  , one  .half 
integer*2  izero  .ione  ,i two 

common  /VCONST/  pi  .halfpi  .degrad  .raddeg  .zero  .one  ,hal f  , 

A  izero  ,ione  , i two 

double  precision  delyk  ,  twod  ,hal fd  .dsq 
common  /VANCH/  delyk  ,  1 *od  .hal fd  .dsq 

double  precision  snphih  .csphih  .snafh  .csafh  .tnafh  .scafh 
common  /VHD1R/  snphih  .csphih  .snafh  .csafh  .inafh  .scafh 

i n  t  eaer  *2  i scope  ,  i scopb  ,  1 1  ana  ,  i t  anb  ,  t  e 
double  precision  epsy  .gamma  ,se 

common  / VCMPO/  epsy  .gamma  ,se  ,  i scope  .  i scopb  ,  i i ana  .  i t  anb  ,  i e 
inieger*2  i rant 

double  precision  qa  ,qb  ,snph i  , i naf a  , t na fb  , 

A  seca7  ,seca8  ,ut  ,st  .yk  l  ,zk  i  ,eex  ,eez  ,eey  .ybuoy 
common  /VCSSHP/  qa  ,qb  ,snph i  ,  1 na f a  .  1 nafb  , 

A  seca7  ,seca8  ,ui  .si  ,yk  i  ,zk  i  ,eex  .eez  ,eey  .ybuoy  ,i  lam 

equivalence  (del  a  ,ta  I  ,  (del b  .root  I  .tb  1  ,  (delasq  ,coef  f 2  ,  temp  .gamma )  , 

A  lep  ,coe  f  f  1  ,eex  )  ,  Icoe  f  f0  ,di  scr  ,eez  I  ,  ( s  1  ope  .eey  )  ,  (dsnph  ,r  to  i  ) 

******************************** :**************************************** 
dsnph-d*snphih 
if  ( a  ne  aa )  go i o  100 
x-a 

y-dsqr i (a* (e*dsnph+dsnph I +dsq I 
go i o  1 000 
1 00  cont  mue 
dela-ae-a 
de 1 asq-de I  a* de I  a 
delb-bb-b 
cp-a*bb-aa*b 
coef  f0-dsq*delasq-cp*cp 
coef  ft -cp#delb+dsnph*delasq 
slope-delb/dela 

if  (dabs (one-dabs (slope  )  I  gt  t  0d-6)  goto  200 
x-  -coe f f 0/ (coef f I +coe f f (  i 
goto  500 
200  coni  mue 

coef  f2-delasq-delb*delb 

di scr-dsqr I (coe  f  f  t  *coef  ft -coef  f 2*coef  f0 I 
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